Probleme inscription valeur dans deux tableu diferent

Le 26/12/2016 à 14:12

Bonjour,

j ai un problème dans l'inscription de mon résultat , des lors que ma note est supérieur a l’année précédente et que mon checkbox n'est pas cocher cela supprime bien ma ligne dans mon tableau Recap mais cela change ma note "tableau donne équipement "ce que je ne veux pas " et je n arrive pas du tout a résoudre mon problème

je ne vois pas ou est mon erreur

merci de votre aide

j ai 3 conditions voir le code ci dessous

je souhaite a toutes et tous sur le forum de passé de bonne fête

encore merci a tous de nous aidez

Private Sub CommandButton1_Click()

Dim l_info As Integer
Dim L As Integer
Dim note_1 As String, note_2 As String, lanote As String
Dim ws As Worksheet
Dim ds As Worksheet
'protection feuille
Dim cell As Range
                Dim pl As Range
                Worksheets("TABLEAU RECAP").Visible = True
                Worksheets("TABLEAU RECAP").Unprotect ("cedric")
                Sheets("TABLEAU RECAP").Cells.Locked = True
                For Each cell In Sheets("TABLEAU RECAP").Range("M2")
                    If cell.MergeCells = True Then
                        Set pl = cell.MergeArea
                        cell.UnMerge
                        cell.Locked = False
                        pl.Merge
                    Else
                        cell.Locked = False
                    End If
                Next cell
                Worksheets("TABLEAU RECAP").Protect ("cedric"), DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True

With ThisWorkbook.Worksheets("TABLEAU RECAP")
 l_info = .Cells(.Rows.Count, 2).End(xlUp).Row + 1

     .Range("B" & l_info).Value = ComEQUI 'libelle equipement'
        .Range("c" & l_info).Value = Textlocal 'code local"
        .Range("D" & l_info).Value = ComRESP 'Nom du responsable'
        .Range("E" & l_info).Value = CDate(TextDATEAM) 'date du constat'
        .Range("F" & l_info).Value = CDate(TextMISE) 'date de mise en service'
        .Range("G" & l_info).Value = CInt(TextDUREVIE.Value)  'Duree de vie theorique'
        .Range("H" & l_info).Value = CDate(TextREMPL) 'Date theorique de remplacement '
        .Range("I" & l_info).Value = CInt(TextDURVIERESI.Value)  'Duree de vie residuelle '
        .Range("J" & l_info).Value = TextESTIMREMPL 'Duree de vie residuelle '
        .Range("K" & l_info).Value = CInt(TextRESUETAT.Value) 'note de etat equipement'
        .Range("l" & l_info).Value = CInt(TextRESUCRIT.Value) 'note de criticite equipement'
        .Range("t" & l_info).Value = "cliquer pour validation"

If CheckBox1.Value Then
'cas case cochee
.Range("p" & l_info).Value = "x"
.Range("q" & l_info).Value = CDate(Textboxdatechange) 'date de remplacement équipement
MsgBox ("attention imformer au equipe gmao le changement de l'equipement")
Else
'cas case non cochee
'rien ?
End If

 If UserFormpri.CheckBox1.Value = True Then
 userform2.TextBox6.Value = Me.ComEQUI.Value  'colle valeur équipement dans le texbox de l'uesrform2 et l'appeler
 userform2.Show
 Else
'rien
End If

With .Range("M" & l_info)
                'formulation
                .FormulaR1C1 = "=IF(RC[-2]<=21,""Mauvais"",IF(RC[-2]<=43,""Usuel"",IF(RC[-2]<=64,""Bon"")))"
                'équivaut à un collage spécial valeur
                .Value = .Value
                note_1 = .Value
         End With

         With .Range("N" & l_info)
                'formulation
                .FormulaR1C1 = "=IF(RC[-2]<=21,""Faible"",IF(RC[-2]<=43,""Moyenne"",IF(RC[-2]<=64,""Forte"")))"
                'équivaut à un collage spécial valeur
                .Value = .Value
                note_2 = .Value
         End With

        Select Case True
                    Case note_1 = "Mauvais" And note_2 = "Faible"
                            lanote = "B"
                    Case note_1 = "Mauvais" And note_2 = "Moyenne"
                            lanote = "C"
                    Case note_1 = "Mauvais" And note_2 = "Forte"
                            lanote = "C"

                     Case note_1 = "Usuel" And note_2 = "Faible"
                            lanote = "A"
                    Case note_1 = "Usuel" And note_2 = "Moyenne"
                            lanote = "B"
                    Case note_1 = "Usuel" And note_2 = "Forte"
                            lanote = "B"

                     Case note_1 = "Bon" And note_2 = "Faible"
                            lanote = "A"
                    Case note_1 = "Bon" And note_2 = "Moyenne"
                            lanote = "A"
                    Case note_1 = "Bon" And note_2 = "Forte"
                            lanote = "A"

        End Select

.Range("O" & l_info).Value = lanote 'donne de la note dans le tableau recap

'si mon chexbox est cocher et que la note est superieur a l'annee d'avant message et fermeture de userform et sans validation dans le tableau recap

Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
 ds.Range("G" & L).Value = lanote

Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
If MsgBox("Note différente de l'année dernière", vbOK Or vbCancel) = vbOK Or vbCancel Then
Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
  MsgBox ("Recommencer l'evaluation")

   End If

   Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ds.Range("G" & L).Value = lanote = lanote And CheckBox1.Value = False Then
ds.Range("G" & L).Value = lanote

End If

Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row  'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire
 If ds.Range("G" & L).Value < lanote And CheckBox1.Value = False Then

  End If

Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row  'si la note est superieur  a la donne dans G "donnée equipement" et chexbox coché message et inscription de la nouvelle note
 If ds.Range("G" & L).Value < lanote And CheckBox1.Value = True Then
 ds.Range("G" & L).Value = lanote

     End If

End If

 End With

Me.hide

Unload UserFormpri

End Sub

'saisie des options'

Private Sub OptionButton1_Change()
    Call note_etat
End Sub
Private Sub OptionButton2_Change()
    Call note_etat
End Sub
Private Sub OptionButton3_Change()
    Call note_etat
End Sub
Private Sub OptionButton4_Change()
    Call note_etat
End Sub
Private Sub OptionButton5_Change()
    Call note_etat
End Sub
Private Sub OptionButton6_Change()
    Call note_etat
End Sub
Private Sub OptionButton7_Change()
    Call note_etat
End Sub
Private Sub OptionButton8_Change()
    Call note_etat
End Sub
Private Sub OptionButton9_Change()
    Call note_etat
End Sub
Private Sub OptionButton10_Change()
    Call note_etat
End Sub
Private Sub OptionButton11_Change()
    Call note_etat
End Sub
Private Sub OptionButton12_Change()
    Call note_etat
End Sub
Private Sub OptionButton13_Change()
    Call note_crit
End Sub
Private Sub OptionButton14_Change()
    Call note_crit
End Sub
Private Sub OptionButton15_Change()
    Call note_crit
End Sub
Private Sub OptionButton16_Change()
    Call note_crit
End Sub
Private Sub OptionButton17_Change()
    Call note_crit
End Sub
Private Sub OptionButton18_Change()
    Call note_crit
End Sub
Private Sub OptionButton19_Change()
    Call note_crit
End Sub
Private Sub OptionButton20_Change()
    Call note_crit
End Sub
Private Sub OptionButton21_Change()
    Call note_crit
End Sub
Private Sub OptionButton22_Change()
    Call note_crit
End Sub
Private Sub OptionButton23_Change()
    Call note_crit
End Sub
Private Sub OptionButton24_Change()
    Call note_crit
End Sub
'calcul des notes'
Private Sub note_etat()
Dim i As Integer, etat1 As Integer, etat2 As Integer, etat3 As Integer

i = 0
etat1 = 0
While i <= 3
    etat1 = etat1 - (i + 1) * CInt(Frame2.Controls(i).Value)
    i = i + 1
Wend
i = 0
etat2 = 0
While i <= 3
    etat2 = etat2 - (i + 1) * CInt(Frame3.Controls(i).Value)
    i = i + 1
Wend
i = 0
etat3 = 0
While i <= 3
    etat3 = etat3 - (i + 1) * CInt(Frame4.Controls(i).Value)
    i = i + 1
Wend
TextRESUETAT = etat1 * etat2 * etat3
End Sub

Private Sub note_crit()
Dim i As Integer, crit1 As Integer, crit2 As Integer, crit3 As Integer

i = 0
crit1 = 0
While i <= 3
    crit1 = crit1 - (i + 1) * CInt(Frame6.Controls(i).Value)
    i = i + 1
Wend
i = 0
crit2 = 0
While i <= 3
    crit2 = crit2 - (i + 1) * CInt(Frame7.Controls(i).Value)
    i = i + 1
Wend
i = 0
crit3 = 0
While i <= 3
    crit3 = crit3 - (i + 1) * CInt(Frame8.Controls(i).Value)
    i = i + 1
Wend
TextRESUCRIT = crit1 * crit2 * crit3
End Sub

j ai modifier mon code au niveau des valeur qui doivent s’inscrire dans le tableau donne équipement mais cela ne marche toujours pas

aidez moi

Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ws.Range("O" & l_info).Value = "" Then 'donne de la note dans le tableau recap
ws.Range("o" & l_info).Value = lanote
ElseIf ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
If MsgBox("Note différente de l'année dernière", vbOK) = vbOK Then
Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
  MsgBox ("Recommencer l'evaluation")

   End If

 [color=#FF0000]  Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row

If ds.Range("G" & L).Value = lanote = lanote And CheckBox1.Value = False Then
ds.Range("G" & L).Value = lanote

ElseIf ds.Range("G" & L).Value < lanote And CheckBox1.Value = False Then 'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire

ElseIf ds.Range("G" & L).Value > lanote And CheckBox1.Value = True Then 'si la note est superieur  a la donne dans G "donnée equipement" et chexbox coché message et inscription de la nouvelle note
ds.Range("G" & L).Value = lanote

Else
ds.Range("G" & L).Value = lanote
  End If[/color]

End If

 End With

merci

Le 27/12/2016 à 09:22

bonjour

mon avis perso de moi tout seul et que personne n'est obligé de suivre (il faut préciser que je fais le suivi des équipements de plusieurs entreprises) : supprimer tout le VBA, faire une table des équipements et une table des interventions. Un petit coup de RECHERCHEV pour lier les 2 tables si besoin.

Tout le reste se fait par des filtres et des TCD.

mébon, si tu préfères le VBA...

Le 27/12/2016 à 14:34
jmd a écrit :

bonjour

mon avis perso de moi tout seul et que personne n'est obligé de suivre (il faut préciser que je fais le suivi des équipements de plusieurs entreprises) : supprimer tout le VBA, faire une table des équipements et une table des interventions. Un petit coup de RECHERCHEV pour lier les 2 tables si besoin.

Tout le reste se fait par des filtres et des TCD.

mébon, si tu préfères le VBA...

Je suis assez d'accord avec jmd (que je salue) parce que un fichier sera traité en VBA si excel ne sait pas le faire (somme des gras par ex) ou bien si on a de très gros fichiers , et sans vba excel sait faire un tas de choses

P.

Rechercher des sujets similaires à "probleme inscription valeur deux tableu diferent"