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

Invité · 09/05/2017, 15h16

Bonjour,
https://www.developpez.net/forums/d1...s/#post8631393

https://www.developpez.net/forums/d1...f/#post8959731

**Vincenzop22** · 09/05/2017, 19h59

Merci à tous pour vos contributions.

J'ai retenu la solution de RyuAutodidacte qui correspond exactement à ce que je recherchais.
La clé recherchée dans mon cas est unique donc pas de problème. De plus, la vitesse d’exécution est impressionnante par rapport aux nombres de données traitées.
Vous m'avez vraiment sorti une épine du pied.

Il ne me reste plus qu'à me familiariser un peu plus avec les collections. cela m'ouvre de nouvelles perspectives.

Encore un gros merci à vous. A bientôt et vive ce forum

VBA - Boucles conditions avec Find et FindNext qui posent problèmes [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager