VBA - Boucles conditions avec Find et FindNext qui posent problèmes

**Vincenzop22** · 07/05/2017, 17h41

Bonjour à tous,

voilà mon premier post sur ce forum que je parcours dans tous les sens depuis quelques temps. Je vous expose mon problème: j'ai un classeur excel une feuille ImportDonnées dans laquelle j'importe un un CSV régulièrement qui est tenu à jour. J'ai une seconde feuille que j'appelle ImportReporting qui me sert de base de travail pour mes userforms.
Selon la valeur trouvée dans la 1ere colonne de ImportDonnées je voudrais :
- que chaque nouvelle ligne soit ajoutée si elle n'existe pas dans FeuilleReporting.
- Si elle existe et que les données des colonnes B sont égales, alors les données des colonnes B a R soient mis à jour dans ImportReporting.
- Si elle existe et que les données des colonnes B sont différentes, alors je les ajoute dans ImportReporting.

Voilà 10 jours que je galère avec cette macro, à force de tourner ça dans tous les sens et de différentes manière je craque et lance un appel à l'aide. Je vous colle ici mon code qui boucle en rond.

Merci pour vos conseils, commentaires ou corrections

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim ligne1 As Long, LastLig1 As Long, ligne2 As Long, LastLig2 As Long, LigneCopie As Long, i As Long
Dim C As Range
 
 
 
Sub EssaiComparaison()
 
 
 
 
 
Set wsh1 = Worksheets("ImportReporting")
Set wsh2 = Worksheets("ImportDonnées")
LastLig1 = wsh1.Cells(Rows.Count, "A").End(xlUp).Row 'comptage des lignes feuille ImportReporting
LastLig2 = wsh2.Cells(Rows.Count, "A").End(xlUp).Row 'comptage des lignes feuille ImportDonnées
 
'Pour ligne2 = 2 jusqu'à LastLig2 denière ligne de la feuille importDonnées
For ligne2 = 2 To LastLig2 'définir quel est la ligne de départ
 
 
    'recherche dans la colonne A de la feuille ImportReporting la valeur de la cellule "ligne2,"A" dans la feuille importDonnées
    With Worksheets("ImportReporting").Columns(1)
    Set C = .Find(wsh2.Cells(ligne2, "A"), LookIn:=xlValues)
 
 
    ' si l'occurence n'est pas trouvée
    If C Is Nothing Then
 
            ' Copie les données de ImportDonnées sur la dernière ligne +1 de la feuille ImportReporting
            LastLig1 = LastLig1 + 1
            wsh1.Range("A" & LastLig1, "R" & LastLig1).Value = wsh2.Range("A" & ligne2, "R" & ligne2).Value
 
 
        'Sinon
    Else
 
            FirstAddress = C.Address ' on retient l'adresse de la première occurence trouvée
            i = C.Row 'on défini le numéro de ligne de cette adresse
            'si la valeur de la colonne B de ImportReporting est différente de la valeur de la colonne "B" de ImportDonnées alors
            If wsh1.Cells(i, "B").Value <> wsh2.Cells(ligne2, "B").Value Then
                    Do
                    'Recherche prochaine occurence
                    Set C = .FindNext(C)
                    i = C.Row
                    'Boucle jusqu'à ce qu'occurence trouvée ET colonnes B de ImportDonnées et ImportReporting soient égales
                    Loop Until Not C Is Nothing And C.Address <> FirstAddress & wsh1.Cells(i, "B").Value = wsh2.Cells(ligne2, "B").Value
                    i = C.Row
 
                    ' copie sur ImportReporting les valeurs impotDonnées
                    wsh1.Range("B" & i, "R" & i).Value = wsh2.Range("B" & ligne2, "R" & ligne2).Value
                    'MsgBox ("Occurence trouvée et condition remplie, Ligne mise à jour" & C.Row)
                    'Exit Do
 
 
            'Sinon La première occurence trouvée était la bonne, mise à jour des données
            Else
                    ' Copie les données de ImportDonnées sur la dernière ligne +1 de la feuille ImportReporting
                    LastLig1 = LastLig1 + 1
                    wsh1.Range("A" & LastLig1, "R" & LastLig1).Value = wsh2.Range("A" & ligne2, "R" & ligne2).Value
            End If
 
    End If
    End With
 
 
Set C = Nothing
 
Next ligne2
 
 
End Sub

**RyuAutodidacte** · 07/05/2017, 18h13

bonjour,
une petite recherche dans

: https://vb.developpez.com/faqvba/?page=3.4.2#Find

C'est l'une des premières erreurs lorsque l'on débute

**Vincenzop22** · 07/05/2017, 18h40

Bonjour,

merci pour le conseil. J'ai regardé et j'essaye d'adapter ce code.

J'essaye de comprendre le déroulement. Je ne vois pas à quel niveauje dois inclure mes conditions. La boucle tourne sans fin avec le Loop à la 3eme occurrence trouvée.
Je me demande à quoi sert la variable PlageResult en l'état.
Ou dois-je inclure mes conditions, faut-il que je refasse des boucles ? After:=ActiveCell et xlValues m'indiquent des valeurs bizarres.

J'ai peur de ne pas avoir bien saisi le code

Merci pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim ligne1 As Long, LastLig1 As Long, ligne2 As Long, LastLig2 As Long, LigneCopie As Long, i As Long
 
 
 
 
Sub EssaiComparaison()
 
Dim C As Range, PlageResult As Range, FirstAdress As String
 
Set wsh1 = Worksheets("ImportReporting")
Set wsh2 = Worksheets("ImportDonnées")
LastLig1 = wsh1.Cells(Rows.Count, "A").End(xlUp).Row 'comptage des lignes feuille ImportReporting
LastLig2 = wsh2.Cells(Rows.Count, "A").End(xlUp).Row 'comptage des lignes feuille ImportDonnées
 
'Pour ligne2 = 2 jusqu'à LastLig2 denière ligne de la feuille importDonnées
For ligne2 = 2 To LastLig2 'définir quel est la ligne de départ
 
 
    'recherche dans la colonne A de la feuille ImportReporting la valeur de la cellule "ligne2,"A" dans la feuille importDonnées
    With Worksheets("ImportReporting").Columns(1)
 
    Set C = .Find(wsh2.Cells(ligne2, "A"), After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
 
    ' si l'occurence est trouvée
    If Not C Is Nothing Then
 
 
            FirstAddress = C.Address ' on retient l'adresse de la première occurence trouvée
            i = C.Row 'on défini le numéro de ligne de cette adresse
 
            Do
 
                If PlageResult Is Nothing Then
                    Set PlageResult = C
                Else
                    Set PlageResult = Application.Union(C, PlageResult)
                End If
                    Set C = .FindNext(C)
 
            Loop While Not C Is Nothing And C.Address <> FirstAddress
    End If
 
       'MsgBox ("Copie sur la dernière ligne +1 de ImportReporting")
       'Copie les données de ImportDonnées sur la dernière ligne +1 de la feuille ImportReporting
            LastLig1 = LastLig1 + 1
            wsh1.Range("A" & LastLig1, "R" & LastLig1).Value = wsh2.Range("A" & ligne2, "R" & ligne2).Value
 
 
 
  End With
 
  Set C = Nothing
 
Next ligne2
 
  End Sub

**RyuAutodidacte** · 07/05/2017, 22h34

je pourrais avoir un exemple des données (avec de fausses données bien sur) sur un fichier xlsx (pas xls ou xlsm) en montrant ce que l'on a au début sur les 2 feuilles et une feuilles en plus montrant le résultat voulu

**Vincenzop22** · 07/05/2017, 22h40

Voici le Fichier:

Je voudrais copier les données présentes dans la feuille ImportDonnées (les plus à jour) vers les bonnes lignes de la feuille ImportReporting, des colonnes B a R pour garder les bonnes annotations présentes dans les colonnes S et T d'ImportReporting.
Si la ligne n'existe pas dans ImportReporting alors copie sur la dernière ligne.

J'espère être clair, et surtout merci pour l'aide, parceque vraiment je m'accroche mais je rameEssaiComparaison.xlsx

**Docmarti** · 07/05/2017, 23h08

Bonjour.

Si tu cherches une egalite sur la colonne A seulement, FIND peut etre utilise.
Mais si tu cherches une egalite sur plus d'une colonne, FIND n'est pas approprie.

Il te faut recourir a des boucles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub EssaiComparaison()
 
Set orig = Worksheets("ImportDonnées")
 
Set dest = Worksheets("ImportReporting")
 
For i = 2 To orig.Cells(Rows.Count, "A").End(xlUp).Row
 
whatA = orig.Cells(i, "A")
whatB = orig.Cells(i, "B")
 
copier = False
For j = 2 To dest.Cells(Rows.Count, "A").End(xlUp).Row
 
If dest.Cells(j, "A") = whatA Then
 
If dest.Cells(j, "B") = whatB Then
 'Mise a jour de la ligne
 copier = True
 'ton code
 '...
 Exit For
End If
End If
Next j
If copier = False Then
 'Nouvel element sur nouvelle ligne
 'ton code
 '...
End If
 
Next i
 
End Sub

**Vincenzop22** · 07/05/2017, 23h30

Merci pour votre aide.

DocMarti, j'essaye aussi d'adapter ton code, c'est comme ça qu'on progresse.
Je repasse vous faire un petit compte rendu dès que possible. En tout cas, merci pour votre aide précieuse. Je me ens moins seul

**RyuAutodidacte** · 08/05/2017, 01h47

Re,

Le forum Excel à buggué, je n'y avais plus accès (je ne sais pas si c'était que chez moi … ?)

Voilà la solution que je te propose (il faudra que tu vois les collections et comment cela marche :
grosso modo, pour chaque entrée dans une collection on insère un item (représentant une valeur, j'ai pris le n° de ligne) et une clé (comme un ID en qq sorte) qui ne peut être que unique (j'ai utilisé les ref en col A)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub MAJDonnees()
Dim Coll As New Collection, Source As Worksheet, Dest As Worksheet, i&, L&
 
    Set Source = Sheets("ImportDonnées")
    Set Dest = Sheets("ImportReporting")
 
    With Dest
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        Coll.Add i, CStr(.Cells(i, 1)) 'Je considère qu'il n'y a pas de Réf. en doublons dans ImportReporting => pas de gestion d'erreur
    Next
    End With
        Application.ScreenUpdating = False
    With Source
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            On Error Resume Next
            Coll.Add i, CStr(.Cells(i, 1))
            L = Coll(.Cells(i, 1))
            If Err.Number > 0 Then
                Dest.Range("B" & L & ":R" & L).Value = .Range("B" & i & ":R" & i).Value
            Else
                DL = Dest.Cells(Rows.Count, 1).End(xlUp)(2).Row
                Dest.Range("A" & DL & ":R" & DL).Value = .Range("A" & L & ":R" & L).Value
            End If
            On Error GoTo 0
        Next
    End With
        Application.ScreenUpdating = True
        Set Source = Nothing: Set Dest = Nothing
End Sub

Edit : il doit y avoir une erreur je pense dans le fichier exemple ou il y a des Ref. en doublons sur "ImportDOnnées", est ce le cas ?

exemples :

A0001 PARIS Pierre PARIS
A0001 Marseille Paul Marseille

A0006 Marseille Yves Marseille
A0006 Rennes Jean Rennes

**Vincenzop22** · 08/05/2017, 10h23

Bonjour RyuAutodidacte,

merci pour la réponse, le forum n'était pas accessible chez moi aussi. Je me penche donc sur les collections.
Je n'ai pas été assez précis dans ma description, car il y a bien des doublons dans la ligne A. C'est pour cela que je cherchais à boucler avec la colonne "B":
Sur mon fichier csv source la ref en col A est unique par ville mais peut être commune lorsqu'on travaille avec l'ensemble des villes.

Merci encore.

**RyuAutodidacte** · 08/05/2017, 10h34

re,
dans ton exemple, enlève les doublons et regarde comment marche le code en faisant du pas à pas

Par contre stp redéfini nous bien les crtières de sélection afin que l'on puisse faire un code adéquat …

sinon sur le principe que j'ai fait on peut définir les clés uniques on peut le faire aussi avec concaténation, ex : Ref. + Ville (schématiquement)

Edit : Exemple concret, si on a :

A0001

PARIS

cela fera :
clé = A0001PARIS

Edit 2 : je me retrouve aussi avec des doublons en colonne B; plusieurs fois Paris, Marseille, Bordeaux … selon l'exemple donné

**RyuAutodidacte** · 08/05/2017, 11h19

le même code j'ai juste rajouter la concaténation de Ref et Ville :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub MAJDonnees2()
Dim Coll As New Collection, Source As Worksheet, Dest As Worksheet, i&, L&
 
    Set Source = Sheets("ImportDonnées")
    Set Dest = Sheets("ImportReporting")
 
    With Dest
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        Coll.Add i, CStr(.Cells(i, 1) & .Cells(i, 2)) 'Je considère qu'il n'y a pas de Réf. en doublons dans ImportReporting => pas de gestion d'erreur
        Debug.Print "Destination : Ligne " & i & " - Clé = " & .Cells(i, 1) & .Cells(i, 2)
    Next
    End With
        Application.ScreenUpdating = False
    With Source
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            On Error Resume Next
            Coll.Add i, CStr(.Cells(i, 1) & .Cells(i, 2))
            L = Coll(.Cells(i, 1) & .Cells(i, 2))
            If Err.Number > 0 Then
                Debug.Print "Source : Ligne " & Coll(.Cells(i, 1) & .Cells(i, 2)) & " - Clé = " & .Cells(i, 1) & .Cells(i, 2)
                Dest.Range("B" & L & ":R" & L).Value = .Range("B" & i & ":R" & i).Value
            Else
                Debug.Print "Source : Nouvelle ligne dans destination " & " - Clé = " & .Cells(i, 1) & .Cells(i, 2)
                DL = Dest.Cells(Rows.Count, 1).End(xlUp)(2).Row
                Dest.Range("A" & DL & ":R" & DL).Value = .Range("A" & L & ":R" & L).Value
            End If
            On Error GoTo 0
        Next
    End With
        Application.ScreenUpdating = True
        Set Source = Nothing: Set Dest = Nothing
End Sub

J'ai mis des Debug.Print pour visualiser le résultat dans la fenêtre d'exécution

**Vincenzop22** · 08/05/2017, 13h08

Merci mille fois

au premier abord, ça à l'air de fonctionner Nickel, c'est la première fois que je me retrouve avec le bon nombre de lignes après exécution de la fonction en présence de doublons dans la colonne A dans la feuille importDOnnées et ImportREporting.
Après un rapide coup d’œil, les mises à jour semblent s'être faite correctement. Je vais le faire pas-à-pas comme tu me l'as préconisé, histoire de bien comprendre le fonctionnement.
Je teste aussi en partant de nouvelles données d'ImportDonnées.
Je vous tiens informé de la suite

**RyuAutodidacte** · 08/05/2017, 14h37

il faut comprendre que dans une collection la clé est unique, donc si on a :
clé = A0001PARIS
et que l'on retombe sur la même clé à ajouter:
clé = A0001PARIS
le code va générer une erreur puisque dans une collection toutes les clés sont uniques et donc impossible d'avoir des doublons
et par conséquent l'ajout ne peut se faire

Cela veut dire que si l'on a une erreur la condition détectant cette erreur saura que l'on doit faire une mise à jour des données, dans le cas contraire on ajoute une nouvelle donnée

PS : le 1er code était OK, il fallait juste être plus explicite au départ sur les critères (entre autre il manquait la 3è feuille donnant le résultat final dans le fichier exemple joint),
comme quoi, surtout dans le codage, il faut être le plus explicite et exhaustif avec tout les tenants et aboutissants afin d'atteindre le but final;
des infos manquantes et on tombe à côté de la problématique

voilà

**Marc-L** · 08/05/2017, 17h46

Bonjour,

oui c'est possible avec la méthode Find, juste en posant sur papier la logique avant d'écrire la première ligne de code !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Compare Text
 
Sub Demo()
        Dim R&, Rg As Range, Rf As Range, A$
            Set Rg = Feuil1.UsedRange.Rows
            Application.ScreenUpdating = False
   For R = 2 To Rg.Count
        With Feuil2.UsedRange.Columns(1).Cells
            Set Rf = .Find(Rg.Cells(R, 1).Value, , xlValues, xlWhole)
             If Rf Is Nothing Then
                Rg(R).Copy .Item(.Count + 1)
             Else
                A = Rf.Address
                    Do
                        If Rf(1, 2).Value = Rg.Cells(R, 2).Value Then
                            A = ""
                            Rg(R).Copy Rf
                            Exit Do
                        End If
                           Set Rf = .FindNext(Rf)
                    Loop Until Rf.Address = A
                If A > "" Then Rg(R).Copy .Item(.Count + 1)
             End If
        End With
   Next
            Application.ScreenUpdating = True
            Set Rg = Nothing:   Set Rf = Nothing
End Sub

___________________________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Stockholm, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**Docmarti** · 09/05/2017, 11h22

@Marc : Oui c'est possible avec Find. J'aurais du utiliser ma table a dessin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub EssaiComparaisonFIND() 'Docmarti
 
    Set orig = Worksheets("ImportDonnées")
 
    Set Dest = Worksheets("ImportReporting")
 
    nbrMises_A_Jour = 0
    nbrNouvellesLignes = 0
 
    For i = 2 To orig.Cells(Rows.Count, "A").End(xlUp).Row
 
        whatA = orig.Cells(i, "A")
        whatB = orig.Cells(i, "B")
 
        Set trouver = Nothing
        Set trouver = Dest.Columns(1).Find(What:=whatA, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
 
        If trouver Is Nothing Then
            copier = False
 
        Else
            copier = False
 
            Set premiere = trouver
 
            Do
 
                If Dest.Cells(trouver.Row, "B") = whatB Then
                    copier = True
                    memeligneDest = trouver.Row
                    orig.Range(orig.Cells(i, "C"), orig.Cells(i, "R")).Copy Dest.Cells(memeligneDest, "C")
                    nbrMises_A_Jour = nbrMises_A_Jour + 1
 
                Else
 
                    Set trouver = Dest.Columns(1).Find(What:=whatA, after:=trouver, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
 
                End If
 
            Loop While copier = False And trouver.Address <> premiere.Address
        End If
 
        If copier = False Then
            dernierLigne = Dest.Cells(Rows.Count, 1).End(xlUp).Row + 1
            orig.Range(orig.Cells(i, "A"), orig.Cells(i, "R")).Copy Dest.Cells(dernierLigne, "A")
            nbrNouvellesLignes = nbrNouvellesLignes + 1
        End If
 
    Next i
    Message = "Mises a jour = " & nbrMises_A_Jour & vbLf & "Nouvelles lignes = " & nbrNouvellesLignes
    MsgBox Message, vbOKOnly, orig.Name
 
End Sub

**Marc-L** · 09/05/2017, 12h25

Salut l'ami de la Belle Province !

En fait c'était en réponse à la présentation initiale : « Voilà 10 jours que je galère » !

Mon code fonctionnant directement avec le classeur joint dans le post #5 …

**RyuAutodidacte** · 09/05/2017, 12h52

Coucou tous,

Docmarti, je ne sais pas si ça le fait chez toi mais j'ai une erreur 448 ("Argument nommé introuvable") dans ton code en ligne 17 (je suis sur Mac)

hi Marc pas souci pour ton code, j'aurai envie de dire comme d'hab.

**Docmarti** · 09/05/2017, 14h51

Envoyé par RyuAutodidacte

Docmarti, je ne sais pas si ça le fait chez toi mais j'ai une erreur 448 ("Argument nommé introuvable") dans ton code en ligne 17 (je suis sur Mac)

@RyuAutodidacte : Il semble qu'il n'y ait pas d'argument SearchFormat sur MAC.

Donc
sur Windows :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set trouver = Dest.Columns(1).Find(what:=whatA, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

et sur MAC :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set trouver = Dest.Columns(1).Find(what:=whatA, LookIn:=xlFormulas, LookAt:=xlWhole,  SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

C'est bon a savoir. Merci.