[Toutes versions] VBA problème de cas non pris en compte

VBA problème de cas non pris en compte

Bonjour à tous,

La macro ouvre un premier fichier, dans l'onglet liste elle cherche ligne par ligne la valeur de la celulle E.
Si c'est écrit "relevé" alors on copie colle une partie de la ligne dans l'onglet "amélioration" de notre fichier.
On ouvre un second fichier et avec l'identifiant récupéré dans le premier fichier on trouve les lignes associées dans le second fichier et on récupère d'autres infos que l'on colle également dans notre fichier.

Si c'est écrit "dégradé" on ouvre le second fichier grace à l'indentifiant on récupère une date. Si celle ci est antérieure à 15 mois alors on colle dans l'onglet "dégradation moteur" sinon dans "dégradations". Puis on recupère les infos du 1er fichier dans l'onglet liste.

Le code marche mais il y a un problème. Il s'arrete lorsqu'il ne retrouve pas un identifiant du fichier 1 dans le fichier 2. Je voudrais dans ce cas qu'il passe a la ligne suivante de l'onglet liste. les else dans mon code ne suffisent visiblement pas.

J'espère avoir été assez claire dans mes explications pour que quelqu'un puisse m'aider !!!
Merci d'avance,
bonne journée à tous!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    
    Dim M As String, A As Long, n As Long, ws As Worksheet, cin As Workbook, cin_past As Workbook, wb As Workbook, max As Long
    Dim irb As Worksheet, irb_past As Worksheet, feuill As Worksheet, path As String, ligne As Long, lig As Long, j As Long, rwa As Double
    Dim tranche As Double, d As Date
    
    M = UserForm1.ComboBox1.Value
    A = UserForm1.TextBox1.Value
    MsgBox ("Choisissez le fichier delta")
    path = Application.GetOpenFilename
    Set wb = Workbooks.Open(path)
    Set ws = wb.Worksheets("Liste")
    iNbItems = ActiveSheet.UsedRange.Rows.Count
    MsgBox ("Choisissez le fichier CIN du mois")
    path = Application.GetOpenFilename
    Set cin = Workbooks.Open(path)
    Set irb = cin.Worksheets("IRB2")
    MsgBox ("Choisissez le fichier cin du mois précédent")
    path = Application.GetOpenFilename
    Set cin_past = Workbooks.Open(path)
    Set irb_past = cin_past.Worksheets("IRB2")
    d = DateSerial(Year(Date), Month(Date) - 15, Day(Date))
    
    For i = 5 To iNbItems
        If ws.Range("E" & i).Value = "Relevé" Then
            Set feuill = ThisWorkbook.Sheets("Améliorations")
            lig = feuill.Range("A10000").End(xlUp).Row + 1
            feuill.Range("A" & lig).Value = ws.Range("A" & i).Value
            feuill.Range("B" & lig).Value = ws.Range("B" & i).Value
            feuill.Range("C" & lig).Value = ws.Range("C" & i).Value
            feuill.Range("D" & lig).Value = ws.Range("D" & i).Value
            feuill.Range("E" & lig).Value = ws.Range("J" & i).Value
            feuill.Range("F" & lig).Value = ws.Range("K" & i).Value
            
            rwa = 0
            tranche = 0
            max = irb.Range("B1000000").End(xlUp).Row
            For j = 23 To max
                If ws.Range("A" & i).Value = irb.Range("K" & j).Value Then
                    rwa = rwa + irb.Range("CP" & j).Value
                    tranche = tranche + irb.Range("BW" & j).Value
              Else
                End If
            Next j
            feuill.Range("G" & lig).Value = tranche
            feuill.Range("J" & lig).Value = rwa
            
            rwa = 0
            tranche = 0
            max = irb_past.Range("B1000000").End(xlUp).Row
            For j = 23 To max
                If ws.Range("A" & i).Value = irb_past.Range("K" & j).Value Then
                    rwa = rwa + irb_past.Range("CP" & j).Value
                    tranche = tranche + irb_past.Range("BW" & j).Value
              Else
                End If

            Next j
            feuill.Range("H" & lig).Value = tranche
            feuill.Range("K" & lig).Value = rwa
            
            feuill.Range("I" & lig).FormulaR1C1 = "=RC[-2]-RC[-1]"
            feuill.Range("L" & lig).FormulaR1C1 = "=RC[-2]-RC[-1]"
            
            Set feuill = Nothing
        
        
        ElseIf ws.Range("E" & i).Value = "Dégradé" Then
            max = irb.Range("J1000000").End(xlUp).Row
            MsgBox (max)
            For j = 23 To max
                If ws.Range("A" & i).Value = irb.Range("K" & j).Value Then
                    ligne = j
                    GoTo en
             Else
                End If


            Next j
en:
            If irb.Range("U" & ligne).Value < d Then
                Set feuill = ThisWorkbook.Sheets("Dégradations ""moteur""")
            Else
                Set feuill = ThisWorkbook.Sheets("Dégradations")
            End If
            lig = feuill.Range("A10000").End(xlUp).Row + 1
            feuill.Range("A" & lig).Value = ws.Range("A" & i).Value
            feuill.Range("B" & lig).Value = ws.Range("B" & i).Value
            feuill.Range("C" & lig).Value = ws.Range("C" & i).Value
            feuill.Range("D" & lig).Value = ws.Range("D" & i).Value
            feuill.Range("E" & lig).Value = ws.Range("J" & i).Value
            feuill.Range("F" & lig).Value = ws.Range("K" & i).Value
            
            rwa = 0
            tranche = 0
            max = irb.Range("J1000000").End(xlUp).Row
            For j = 23 To max
                If ws.Range("A" & i).Value = irb.Range("K" & j).Value Then
                    rwa = rwa + irb.Range("CP" & j).Value
                    tranche = tranche + irb.Range("BW" & j).Value
               Else
                End If
  
            Next j
            feuill.Range("G" & lig).Value = tranche
            feuill.Range("J" & lig).Value = rwa
            
            rwa = 0
            tranche = 0
            max = irb_past.Range("B1000000").End(xlUp).Row
            For j = 23 To max
                If ws.Range("A" & i).Value = irb_past.Range("K" & j).Value Then
                    rwa = rwa + irb_past.Range("CP" & j).Value
                    tranche = tranche + irb_past.Range("BW" & j).Value
              Else
                End If

            Next j
            feuill.Range("H" & lig).Value = tranche
            feuill.Range("K" & lig).Value = rwa
            
            feuill.Range("I" & lig).FormulaR1C1 = "=RC[-2]-RC[-1]"
            feuill.Range("L" & lig).FormulaR1C1 = "=RC[-2]-RC[-1]"
            
            Set feuill = Nothing
        
        End If
    Next i
    wb.Close
    cin.Close
    cin_past.Close
    
    Set cin = Nothing
    Set cin_past = Nothing
    Set irb = Nothing
    Set irb_past = Nothing
    Set ws = Nothing
    Set wb = Nothing
    Application.ScreenUpdating = True
    Unload Me
End Sub

Bonjour,

sans regarder le code,

il suffit de rajouter une condition:
si n° pas trouvé alors on passe:
Code:

1 2 3 4 if condition then goto pass end if pass:
et mettre pass: au bon endroit la macro reprendra de la

Merci pour votre aide!

j'avais rajouter une condition comme celle ci mais je ne sais pas comment traduire en code :

Range.Value n'est pas trouvée...
Merci d'avance

Il faut savoir à quelle ligne se fait la recherche et comment elle se fait?

si elle se fait pas un find:

Code:

1
2
3
4
5
6
dim C as range
Set C = Worksheets("nomfeuille").Range("le range dans lequel on cherche").Find(oncherchequellevaleur, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
if C is nothing then
goto pass
end if
pass:

si elle se fait par une collection:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'Création du dictionnaire
Set MyDico = CreateObject("Scripting.Dictionary")
 
 'Remplis le dico avec les référence du range
For Each Cel In Range 'range dans lequel on ajoute les valeur
     If MyDico.Exists(CStr(Cel.Value)) = False And Cel.Value <> "" Then
          MyDico.Add CStr(Cel.Value), Cel.Value
     End If
Next Cel
'on parcours dans le dico les lignes I, si ca existe pas dans le dico alors on pass ( =false)
For I = 1 To 10 'boucle a adapter
 If MyDico.Exists(CStr(.Cells(I, 1).Value)) = False Then
goto pass
end if
 Next I
pass:

Je comprends mais je n'arrive pas bien a l'adapter à mon cas :

Si la valeur de cette cellule = valeur de cette autre cellule alors ....

Code:

If ws.Range("A" & i).Value = irb.Range("K" & j).Value Then

et la partie que je voudrais faire est :

si la valeur de cette cellule n'est pas trouvé dans les valeurs de l'autre fichier alors ....
(j'ai essayé avec "différent de" mais cela ne marchait pas)

Code:

ElseIf ws.Range("A" &i).Value

Merci beaucoup pour votre aide !

Bonjour,

Il faut passer par un dictionnaire de données:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'Création du dictionnaire
DL = Sheets("nom de la feuille ou il y a les donénes").Cells(Rows.Count, 11).End(xlUp).Row '11 pour la colonne k
Set MyDico = CreateObject("Scripting.Dictionary")
'Remplis le dico avec les référence du range
For Each Cel In Range 'range dans lequel on ajoute les valeur. ici remplace range par irb.Range("K1:K" & DL) surement.
     If MyDico.Exists(CStr(Cel.Value)) = False And Cel.Value <> "" Then
          MyDico.Add CStr(Cel.Value), Cel.Value
     End If
Next Cel
'on parcours dans le dico les lignes I, si ca existe pas dans le dico alors on pass ( =false)
For I = 1 To 10 'boucle a adapter
If MyDico.Exists(CStr(nomdelafeuilleduclaseur1.Cells(I, 1).Value)) = False Then 'ici ce sera ws.Range("A" & I).Value
goto pass
end if
Next I
pass: