Discussion :

[bboy-eazy]

Bonjour,

J'essaye de faire une macro qui ferai la chose suivante:

dans le "classeur1" , il y a des références en feuille "analysis" en colonne A
dans le "classeur2" , il y a des références en feuille "famille" en colonne A

Je souhaite parcourir toute les références présentes dans le classeur1 et chercher si la valeur existe dans le classeur2. Si elle n'existe pas dans le classeur2, alors je veux supprimer la ligne de la référence dans le classeur1.

je pense qu'il faut faire un find mais je ne maitrise pas très bien cette méthode alors j'ai testé avec une boucle: voici un début de code mais il y surement mieux.

Aussi je sais pas si c'est important mais il faut tester les références présentes dans le classeur1 et celles présente sont celles qui restent déjà après avoir filtrer pas mal de références. Il y a donc plusieurs filtres actifs pendant la recherche des références présentes dans le classeur1

Pouvez-vous m'aider svp?

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 Recherche()
 
Application.ScreenUpdating = False
 
    Dim LigFin As Long
    Dim NumLot As Long
    Dim LigDeb As Long
    Dim lig As Long
    Dim LigNumLot As Long
 
     If ActiveSheet.AutoFilterMode = True Then
    ActiveSheet.AutoFilterMode = False
    End If
 
   LigFin = Sheets("analysis").Cells(Rows.Count, 1).End(xlUp).Row
   LigDeb = 2
 
 
 
    LigNumLot = 0
    For lig = LigDeb To LigFin
 
If Workbook("classeur1").Sheets("analysis").Cells(lig, 1).Value = Workbook("classeur2").Sheets("famille").Cells(lig, 1).Value Then
LigNumLot = lig
 
 
 
Workbook("classeur1").Worksheets("analysis").Cells(LigNumLot, 1).EntireRow.Delete
 
End If
Next lig
End Sub

[Nico Chg]

Bonjour,

Il y a un petit problème dans ton algo, ta comparaison fonctionne si les deux valeurs sont exactement sur la même ligne !


Dans le petit exemple que j'ai dessiné, tu ne trouveras aucune correspondance, alors qu'il n'y a que ça !
Il y a tout un tas de méthode pour faire des comparaisons, personnellement, j'utilise un dictionnaire.

Plus exactement, je remplis un dictionnaire avec les références qui ne vont pas être supprimé. Dans ton cas, il s'agit du classeur 2.
Ensuite, j'essaie de rentrer les valeurs du classeur 1 dans le dictionnaire. Plus exactement j'utilise l'instruction Dico.Exist(Key)

Si la clef n'existe pas, c'est qu'elle n'était pas dans le classeur 2, et que je peux la supprimer du classeur 1 dans ce cas.

Mais ce n'est qu'une méthode parmi beaucoup d'autre.

[bboy-eazy]

Bonjour et merci de ta réponse

Alors je suis pas très très fort en excel donc les dictionnaires, je ne connais pas du tout. Je vais essayer de chercher si je trouve des trucs la dessus. ca pourra m'être utile et bon à savoir emrci.

Et concernant mon code, j'aimerais bien réussir à le faire. ALors penses tu qu'il faut mettre 2 variables différentes pour que ca marche? par exemple i et n avec i comme variable du classeur 1 et n variable du classeur 2 pour que ça fonctionne?

merci d'avance

[Nico Chg]

Un petit exemple d'utilisation de dictionnaire :

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
Sub CompareReference
Dim WB1 as workbook
Dim WB2 as workbook
Dim RG1 as Range
Dim RG2 as Range
Dim Cel as Range
Dim LastLine1 as single
Dim LastLine2 as single
 
Dim MyDico as Object
 
Set WB1 =  Workbooks("classeur1")
Set WB2 =  Workbooks("classeur2")
'Définit les deux classeurs
 
LastLine1 = WB1.Worksheets("analysis").Columns(1).Find("*", , , , xlByRows, xlPrevious).Row
LastLine2 = WB2.Worksheets("famille").Columns(1).Find("*", , , , xlByRows, xlPrevious).Row
'Calcul de la dernière ligne utilisé
 
With  WB1.Worksheets("analysis")
     Set RG1 = .Range(.Cells(1, 1), .Cells(LastLine1, 1))
End With
'Définit la plage de référence du classeur 1
 
With WB2.Worksheets("famille")
     Set RG2 = .Range(.Cells(1, 1), .Cells(LastLine2, 1))
End with
'Définit la plage de référence du classeur 2
 
Set MyDico = CreateObject("Scripting.Dictionary")
'Création du dictionnaire
 
For Each Cel in RG2
     MyDico.add Cel.Value, Cel.Value
Next Cel
'Remplis le dico avec les référence du classeur 2
 
For Each Cel in RG1
     If MyDico.Exists(Cel.Value) = False then
          WB1.Worksheets("analysis").Cells(Cel.Row, 1).EntireRow.Delete
     End if
Next Cel
'On regarde dans le Dico si les valeurs existent. Si elles n'existent pas, on supprime la ligne dans le classeur 1
 
Set MyDico = Nothing
'On Libère la variable
 
End Sub

Cependant, il existe beaucoup d'autre méthode de comparaison, si ça ne te convient pas

EDIT : La méthode du Dictionnaire s'écrit MyDico.Exists

[bboy-eazy]

Merci beaucoup!

c'est parfait et très bien expliqué! je vais essayer et adapter à mon besoin.

Merci beaucoup Nico Chg

C'est vrai que c'est très simple enfait remplir le dico et comparer! Je pense que cette méthode m'ira très bien

Bonne journée

[bboy-eazy]

Je reviens vers vous car je pensais avoir piger le truc mais j'ai toujours un message d'erreur qui apparait et je ne comprend pas pourquoi:

erreur d'execution 457:
Cette clé est déjà associée à une élement de cette collection

et l'erreur apparait à la ligne

Code :

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

MyDico.Add Cel.Value, Cel.Value

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
Sub CompareReference()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim RG1 As Range
Dim RG2 As Range
Dim Cel As Range
Dim LastLine1 As Single
Dim LastLine2 As Single
 
Dim MyDico As Object
 
Set WB1 = Workbooks("classeur1")
Set WB2 = Workbooks("classeur2")
'Définit les deux classeurs
 
LastLine1 = WB1.Worksheets("analysis").Columns(1).Find("*", , , , xlByRows, xlPrevious).Row
LastLine2 = WB2.Worksheets("Famille").Columns(1).Find("*", , , , xlByRows, xlPrevious).Row
'Calcul de la dernière ligne utilisé
 
With WB1.Worksheets("analysis")
     Set RG1 = .Range(.Cells(1, 1), .Cells(LastLine1, 1))
End With
'Définit la plage de référence du classeur 1
 
With WB2.Worksheets("Famille")
     Set RG2 = .Range(.Cells(1, 1), .Cells(LastLine2, 1))
End With
'Définit la plage de référence du classeur 2
 
Set MyDico = CreateObject("Scripting.Dictionary")
'Création du dictionnaire
 
For Each Cel In RG2
     MyDico.Add Cel.Value, Cel.Value
Next Cel
'Remplis le dico avec les référence du classeur 2
 
For Each Cel In RG1
     If MyDico.Exist(Cel.Value) = False Then
          WB1.Worksheets("analysis").Cells(Cel.Row, 1).EntireRow.Delete
     End If
Next Cel
'On regarde dans le Dico si les valeurs existent. Si elles n'existent pas, on supprime la ligne dans le classeur 1
 
Set MyDico = Nothing
'On Libère la variable
 
End Sub