Comparaison de deux cfeuilles Excel
Bonjour à tous,
Je suis débutant en VBA et je suis actuellement dans une impasse: je souhaiterai comparer deux fichiers Excel assez lourd ( environ 1000 lignes voir plus pour 67 colonnes). J'ai repris un code déjà présent sur ce forum en le modifiant pour qu'il me demande les fichiers que je souhaite comparer. Je souhaiterai que le code compare chaque ligne du fichier A avec toutes les lignes du fichier B et qu'il affiche les différences dans un troisième fichier. Le code est le suivant. Je pense que l'erreur se situe dans la double boucle mais sait-on jamais si il y a d'autres erreurs....
Private Sub cmdAnalyse_Click()
Dim strRepFicA As String, strRepFicB As String
Dim wbFicA As Workbook, wbFicB As Workbook, wbFicAna As Workbook
Dim wsFicA As Worksheet, wsFicB As Worksheet, wsFicAna As Worksheet
Dim lgLig As Long, lgCol As Long, lgLigB As Long, lgColB As Long
Dim lgLigDeb As Long
' Répertoire et Fichier
strRepFicA = Application.GetOpenFilename
strRepFicB = Application.GetOpenFilename
' Classeur d'analyse
Set wbFicAna = ThisWorkbook
Set wsFicAna = wbFicAna.ActiveSheet
' Vérifier que les fichiers A et B se trouvent dans le répertoire
If Dir(strRepFicA) = "" Or Dir(strRepFicB) = "" Then
MsgBox "Le fichier A et/ou le fichier B sont introuvables", vbCritical + vbOKOnly, "Problème de fichiers..."
Exit Sub
End If
Application.ScreenUpdating = False
' Ouverture du fichier A et définition de la feuille de traitement
Set wbFicA = Workbooks.Open(Filename:=strRepFicA)
Set wsFicA = wbFicA.Worksheets("A")
' Ouverture du fichier B et définition de la feuille de traitement
Set wbFicB = Workbooks.Open(Filename:=strRepFicB)
Set wsFicB = wbFicB.Worksheets("A")
' Vider les lignes du fichier d'analyse
wsFicAna.Range("A2:BN" & Cells.Rows.Count).ClearContents
' Première ligne d'affichage des résultats dans le fichier d'analyse
lgLigDeb = 10
' Traitement des lignes des 2 fichiers
' on fait parcourir à la boucle toutes les lignes du 1er fichier de 2 à 1000
For lgLig = 2 To 1000
' on fait parcourir à la boucle toutes les colonnes du 1er fichier de A à BN
For lgCol = 1 To 67
'On fait parcourir à la boucle toutes les lignes du 2eme fichier de 2 à 1000
For lgLigB = 2 To 1000
'On fait parcourir à la boucle toutes les colonnes du 2eme fichier de 1 à 67
For lgColB = 1 To 67
' Une différence est trouvée dans une ligne
If wsFicA.Cells(lgLig, lgCol).Value <> wsFicB.Cells(lgLigB, lgColB).Value Then
' Affichage du nom du fichier en colonne A
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name
' Copier la ligne du fichier A dans le fichier d'analyse
wsFicA.Range("B" & lgLig & ":" & "BO" & lgLig).Copy _
Destination:=wsFicAna.Range("A" & lgLigDeb)
' Affichage du nom du fichier en colonne A
wsFicAna.Range("A" & lgLigDeb + 1).Value = wbFicB.Name
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicB.Range("B" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("A" & lgLigDeb + 1)
lgLigDeb = lgLigDeb + 2
Exit For
End If
Next lgColB
Next lgLigB
Next lgCol
Next lgLig
' Fermer les fichiers A et B
wbFicA.Close savechanges:=False
wbFicB.Close savechanges:=False
MsgBox "Traitement terminé"
Application.ScreenUpdating = True
End Suben vous remerciant de vos réponses
Bonjour,
Je souhaiterai que le code compare chaque ligne du fichier A avec toutes les lignes du fichier B et qu'il affiche les différences dans un troisième fichier.
es-tu sûr de vouloir ce résultat ? j'ai un doute.
pour chaque ligne du fichier A, ça va te sortir toutes les lignes du fichier B qui ne sont pas identiques, il risque d'y en avoir un paquet.
bonjour,
Tout d'abord merci de ta réponse.
Pour recadrer le sujet, je travaille sur des capteurs qui enregistrent un déplacement. Les données des capteurs sont enregistrées dans un fichier excel et je souhaite comparer ce fichier excel avec le cas ou tous les capteurs fonctionnent, ceci pour identifier les capteurs qui ne fonctionnent pas et qu'il faut donc changer. Malheureusement, il est aussi possible que le capteur fonctionne trop et "capte" 2 fois deux entrées (ce qui est un bug). Les deux fichiers ne possèdent pas forcément le même nombre de lignes.
C'est la raison pour laquelle je veux faire une macro qui me renvoie les différences entre les deux fichiers
Merci pour la lecture et les éventuelles réponses
Bonjour,
Avec Excel 2016, tu disposes normalement d'un complément nommé 'Inquire'.
Il va te permettre entre autres, de comparer 2 fichiers ensemble (!?)
Fait une recherche avec notre ami Google et consulte l'aide d'Excel.
Cdlt.
Bonjour Jean-Eric,
Malheureusement,la macro n'est pas pour moi, j'utilise Excel 2016 sur mon ordinateur personnel mais la macro sera utilisée sur une version antérieure. (2013 2010 il me semble mais je ne suis pas sur)
Cordialement
bonjour
soit le contenu du fichier A et B comme suit
A:
1
2
3
B:
1
2
3
4
pour la ligne 1 de A tu auras une différence avec les lignes 2,3 et 4 de B
pour la ligne 2 de A tu auras une différence avec les lignes 1,3, et 4 de B
pour la ligne 3 de A tu auras une différence avec les lignes 1,2 et 4 de B
donc pour chaque ligne de A tu auras toutes les lignes de B sauf celles qui sont absolument identiques à la ligne de A
je me demande bien ce que tu pourras faire de ces informations.
Il y a un Add-in que tu peux télécharger pour la version 2010 (spreadsheet_compare), ça pourrait te faciliter ta comparaison.
Bonjour,
Je pense que je me suis mal exprimé dans mes posts précédents. Ce que je souhaite c'est extraire les différences des deux fichiers dans un 3eme fichier. Les deux fichiers à comparer ne possèdent pas forcements les mêmes nombres de lignes. Les données à l'intérieur des feuilles ne sont, quand à elles, pas dans le même ordre. C'est la raison pour laquelle je voulais comparer une ligne du fichier A avec toutes les lignes du fichier B et si jamais il ne la trouve pas, l'indiquer dans le 3eme fichier (cette ligne est présente dans le fichier A mais pas dans le fichier B).
Si vous avez des propositions d'autres méthodes je suis preneur.
Cordialement
Kheiro a écrit :Il y a un Add-in que tu peux télécharger pour la version 2010 (spreadsheet_compare), ça pourrait te faciliter ta comparaison.
Bonjour Kheiro,
Il s'agit d'ordinateur de société, je ne peux rien télécharger dessus
Bonjour,
un proposition
Option Explicit
Private Sub cmdAnalyse_Click()
Dim strRepFicA As String, strRepFicB As String
Dim wbFicA As Workbook, wbFicB As Workbook, wbFicAna As Workbook
Dim wsFicA As Worksheet, wsFicB As Worksheet, wsFicAna As Worksheet
Dim lgLig As Long, lgCol As Long, lgLigB As Long, lgColB As Long
Dim lgLigDeb As Long
Dim dicoA, dicoB
Dim key
' Répertoire et Fichier
strRepFicA = Application.GetOpenFilename
strRepFicB = Application.GetOpenFilename
' Classeur d'analyse
Set wbFicAna = ThisWorkbook
Set wsFicAna = wbFicAna.ActiveSheet
' Vérifier que les fichiers A et B se trouvent dans le répertoire
If Dir(strRepFicA) = "" Or Dir(strRepFicB) = "" Then
MsgBox "Le fichier A et/ou le fichier B sont introuvables", vbCritical + vbOKOnly, "Problème de fichiers..."
Exit Sub
End If
Application.ScreenUpdating = False
' Ouverture du fichier A et définition de la feuille de traitement
Set wbFicA = Workbooks.Open(Filename:=strRepFicA)
Set wsFicA = wbFicA.Worksheets("A")
' Ouverture du fichier B et définition de la feuille de traitement
Set wbFicB = Workbooks.Open(Filename:=strRepFicB)
Set wsFicB = wbFicB.Worksheets("A")
' Vider les lignes du fichier d'analyse
wsFicAna.Range("A2:BN" & Cells.Rows.Count).ClearContents
' Première ligne d'affichage des résultats dans le fichier d'analyse
lgLigDeb = 10 - 1
' Traitement des lignes des 2 fichiers
Set dicoA = CreateObject("scripting.dictionary")
Set dicoB = CreateObject("scripting.dictionary")
' on crée une entrée dans le dictionnaire pour chaque ligne unique de B
For lgLig = 2 To 1000
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 2eme fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicB.Cells(lgLig, lgCol)
Next lgCol
' si la clé n'existe pas on la sauve
If Not dicoB.exists(key) Then dicoB.Add key, lgLig
Next lgLig
' on crée une entrée dans le dictionnaire pour chaque ligne unique de A
' on regarde si la ligne existe dans B, via le dictionnaire B
For lgLig = 2 To 1000
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 1er fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicA.Cells(lgLig, lgCol)
Next lgCol
If Not dicoA.exists(key) Then dicoA.Add key, lgLig
If Not dicoB.exists(key) Then 'ligne de A n'existe pas dans B
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name
' Copier la ligne du fichier A dans le fichier d'analyse
wsFicA.Range("A" & lgLig & ":" & "BO" & lgLig).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
Next lgLig
For Each key In dicoB.keys 'on vérifie si les lignes de B existent dans A via le dictionnaire
If Not dicoA.exists(key) Then 'ligne de B n'existe pas dans A
' Affichage du nom du fichier en colonne A
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name
' Copier la ligne du fichier B dans le fichier d'analyse
lgLigB = dicoB.Item(key)
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
Next key
' Fermer les fichiers A et B
wbFicA.Close savechanges:=False
wbFicB.Close savechanges:=False
MsgBox "Traitement terminé"
Application.ScreenUpdating = True
End SubBonjour h2so4,
Tout d'abord un grand merci pour ton code et pour le temps que tu as passé à réfléchir et à l'écrire. Si je comprends bien ton code, celui-ci ne renvoie pas les possibles doublon qu'il pourrait y avoir dans les lignes? Je m'explique: parfois les capteurs "captent" deux fois d'affilée les signaux et du coup ils apparaissent aussi deux fois dans les colonnes des fichiers.
Je vais essayer de modifier ton code pour qu'il puisse en plus remonter les erreurs de ce genre et je reviendrai vers toi si vraiment je suis dans une impasse.
Encore mille merci pour ton code et tes réponses
Cordialement
bonjour,
une solution possible
Option Explicit
Private Sub cmdAnalyse_Click()
Dim strRepFicA As String, strRepFicB As String
Dim wbFicA As Workbook, wbFicB As Workbook, wbFicAna As Workbook
Dim wsFicA As Worksheet, wsFicB As Worksheet, wsFicAna As Worksheet
Dim lgLig As Long, lgCol As Long, lgLigB As Long, lgColB As Long
Dim lgLigDeb As Long
Dim dicoA, dicoB
Dim key
' Répertoire et Fichier
strRepFicA = Application.GetOpenFilename
strRepFicB = Application.GetOpenFilename
' Classeur d'analyse
Set wbFicAna = ThisWorkbook
Set wsFicAna = wbFicAna.ActiveSheet
' Vérifier que les fichiers A et B se trouvent dans le répertoire
If Dir(strRepFicA) = "" Or Dir(strRepFicB) = "" Then
MsgBox "Le fichier A et/ou le fichier B sont introuvables", vbCritical + vbOKOnly, "Problème de fichiers..."
Exit Sub
End If
Application.ScreenUpdating = False
' Ouverture du fichier A et définition de la feuille de traitement
Set wbFicA = Workbooks.Open(Filename:=strRepFicA)
Set wsFicA = wbFicA.Worksheets("A")
' Ouverture du fichier B et définition de la feuille de traitement
Set wbFicB = Workbooks.Open(Filename:=strRepFicB)
Set wsFicB = wbFicB.Worksheets("A")
' Vider les lignes du fichier d'analyse
wsFicAna.Range("A2:BN" & Cells.Rows.Count).ClearContents
' Première ligne d'affichage des résultats dans le fichier d'analyse
lgLigDeb = 10 - 1
' Traitement des lignes des 2 fichiers
Set dicoA = CreateObject("scripting.dictionary")
Set dicoB = CreateObject("scripting.dictionary")
' on crée une entrée dans le dictionnaire pour chaque ligne unique de B
For lgLig = 2 To 1000
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 2eme fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicB.Cells(lgLig, lgCol)
Next lgCol
' si la clé n'existe pas on la sauve
If Not dicoB.exists(key) Then
dicoB.Add key, lgLig
Else 'doublon détecté dans B
lgLigDeb = lgLigDeb + 1
lgLigB = dicoB.Item(key)
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name & "ligne " & lgLigB & "/" & liglig
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
Next lgLig
' on crée une entrée dans le dictionnaire pour chaque ligne unique de A
' on regarde si la ligne existe dans B, via le dictionnaire B
For lgLig = 2 To 1000
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 1er fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicA.Cells(lgLig, lgCol)
Next lgCol
If Not dicoA.exists(key) Then
dicoA.Add key, lgLig
Else 'doublon détecté dans A
lgLigDeb = lgLigDeb + 1
lgLigB = dicoA.Item(key)
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name & "ligne " & lgLigB & "/" & liglig
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicA.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
If Not dicoB.exists(key) Then 'ligne de A n'existe pas dans B
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name
' Copier la ligne du fichier A dans le fichier d'analyse
wsFicA.Range("A" & lgLig & ":" & "BO" & lgLig).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
Next lgLig
For Each key In dicoB.keys 'on vérifie si les lignes de B existent dans A via le dictionnaire
If Not dicoA.exists(key) Then 'ligne de B n'existe pas dans A
' Affichage du nom du fichier en colonne A
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name
' Copier la ligne du fichier B dans le fichier d'analyse
lgLigB = dicoB.Item(key)
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
Next key
' Fermer les fichiers A et B
wbFicA.Close savechanges:=False
wbFicB.Close savechanges:=False
MsgBox "Traitement terminé"
Application.ScreenUpdating = True
End SubBonjour h2so4,
Je viens de voir ton code que j'ai testé et je pense qu'il y a une erreur au niveau du doublon. Lorsque je teste la macro sur deux fichiers que j'ai créé, elle me renvoie environ 1800 erreurs sur les 3 qu'elle devrait me renvoyer.
Je te joins en pièce jointe les deux fichiers que j'utilise pour faire les tests.
désolé de te faire travailler autant
Cordialement
bonjour,
correction
Option Explicit
Private Sub cmdAnalyse_Click()
Dim strRepFicA As String, strRepFicB As String
Dim wbFicA As Workbook, wbFicB As Workbook, wbFicAna As Workbook
Dim wsFicA As Worksheet, wsFicB As Worksheet, wsFicAna As Worksheet
Dim lgLig As Long, lgCol As Long, lgLigB As Long, lgColB As Long
Dim lgLigDeb As Long
Dim dicoA, dicoB
Dim key
' Répertoire et Fichier
strRepFicA = Application.GetOpenFilename
strRepFicB = Application.GetOpenFilename
' Classeur d'analyse
Set wbFicAna = ThisWorkbook
Set wsFicAna = wbFicAna.ActiveSheet
' Vérifier que les fichiers A et B se trouvent dans le répertoire
If Dir(strRepFicA) = "" Or Dir(strRepFicB) = "" Then
MsgBox "Le fichier A et/ou le fichier B sont introuvables", vbCritical + vbOKOnly, "Problème de fichiers..."
Exit Sub
End If
Application.ScreenUpdating = False
' Ouverture du fichier A et définition de la feuille de traitement
Set wbFicA = Workbooks.Open(Filename:=strRepFicA)
Set wsFicA = wbFicA.Worksheets("A")
' Ouverture du fichier B et définition de la feuille de traitement
Set wbFicB = Workbooks.Open(Filename:=strRepFicB)
Set wsFicB = wbFicB.Worksheets("A")
' Vider les lignes du fichier d'analyse
wsFicAna.Range("A2:BN" & Cells.Rows.Count).ClearContents
' Première ligne d'affichage des résultats dans le fichier d'analyse
lgLigDeb = 10 - 1
' Traitement des lignes des 2 fichiers
Set dicoA = CreateObject("scripting.dictionary")
Set dicoB = CreateObject("scripting.dictionary")
' on crée une entrée dans le dictionnaire pour chaque ligne unique de B
For lgLig = 2 To 1000
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 2eme fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicB.Cells(lgLig, lgCol)
Next lgCol
' si la clé n'existe pas on la sauve
If key <> "" Then
If Not dicoB.exists(key) Then
dicoB.Add key, lgLig
Else 'doublon détecté dans B
lgLigDeb = lgLigDeb + 1
lgLigB = dicoB.Item(key)
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name & "ligne " & lgLigB & "/" & lgLig
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
End If
Next lgLig
' on crée une entrée dans le dictionnaire pour chaque ligne unique de A
' on regarde si la ligne existe dans B, via le dictionnaire B
For lgLig = 2 To 1000
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 1er fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicA.Cells(lgLig, lgCol)
Next lgCol
If key <> "" Then
If Not dicoA.exists(key) Then
dicoA.Add key, lgLig
Else 'doublon détecté dans A
lgLigDeb = lgLigDeb + 1
lgLigB = dicoA.Item(key)
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name & "ligne " & lgLigB & "/" & lgLig
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicA.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
If Not dicoB.exists(key) Then 'ligne de A n'existe pas dans B
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name
' Copier la ligne du fichier A dans le fichier d'analyse
wsFicA.Range("A" & lgLig & ":" & "BO" & lgLig).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
End If
Next lgLig
For Each key In dicoB.keys 'on vérifie si les lignes de B existent dans A via le dictionnaire
If Not dicoA.exists(key) Then 'ligne de B n'existe pas dans A
' Affichage du nom du fichier en colonne A
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name
' Copier la ligne du fichier B dans le fichier d'analyse
lgLigB = dicoB.Item(key)
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy _
Destination:=wsFicAna.Range("B" & lgLigDeb)
End If
Next key
' Fermer les fichiers A et B
wbFicA.Close savechanges:=False
wbFicB.Close savechanges:=False
MsgBox "Traitement terminé"
Application.ScreenUpdating = True
End SubBonjour,
ça eut été bien de voir 20 lignes de chaque fichier (en les rendant anonymes au besoin)
P.
Bonjour Patrick1957,
Je me rends compte maintenant que la tache aurait été plus facile. J'en suis désolé et tacherai de m'en souvenir à l'avenir.
Désolé de la gène occasionnée
Cordialement
Re-bonjour,
Je suis vraiment navré de vous déranger à nouveau, mais j'aurai une question à propos du code envoyé. lorsque j'augmente la taille du fichier et que j'effectue une modification d'un des deux fichiers, la macro me renvoie 4 erreurs alors que selon moi, elle ne devrait en renvoyer que 2. La modification que j'ai effectuée est la suivante:
- j'ai remplacé le numéro d'enregistrement n°4397 par le numéro n°4398 (situés aux lignes 4405 et 4406 sur le fichier 6). Il y a donc deux numéro d'enregistrements 4398 qui se suivent. Le reste des deux lignes reste inchangé.
J'ai mis en évidence les deux lignes qui diffèrent en jaune.
Je vous remercie énormément pour le temps que vous avez déjà passé à m'expliquer et à réfléchir
Bien cordialement
bonjour,
la macro renvoie une erreur pour
4398 de A qui ne retrouve pas dans B
4397 de B qui ne retrouve pas dans A
4400 de B qui ne retrouve pas dans A
4401 de B qui ne retrouve pas dans A
4 erreurs détectées me parait donc correct
C'est justement au niveau des deux dernière erreurs que je ne comprends pas. Je peux trouver les deux lignes dans chaque fichiers:
- pour 4400 c'est à la ligne 4408
- pour 4401 c'est à la ligne 4409
Je suis désolé de ne pas comprendre
Cordialement
re-bonjour,
en fait se sont les enregistrement 4424 et 4425 qui sont dans B et pas dans A.
dans ton fichier 4424 et 4425 sont générés par une formule (case précédente +1)
lorsque je recopie la ligne dans le fichier d'analyse, je recopie la formule pas la valeur. et donc les formules copiées donnent les valeurs 4400 et 4401.
voici une nouvelle version qui corrige ce problème (que je ne pense que tu rencontreras avec tes données réelles ;o))
Option Explicit
Private Sub cmdAnalyse_Click()
Dim strRepFicA As String, strRepFicB As String
Dim wbFicA As Workbook, wbFicB As Workbook, wbFicAna As Workbook
Dim wsFicA As Worksheet, wsFicB As Worksheet, wsFicAna As Worksheet
Dim lgLig As Long, lgCol As Long, lgLigB As Long, lgColB As Long
Dim lgLigDeb As Long
Dim dicoA, dicoB
Dim key
Dim dla, dlb
' Répertoire et Fichier
strRepFicA = Application.GetOpenFilename
strRepFicB = Application.GetOpenFilename
' Classeur d'analyse
Set wbFicAna = ThisWorkbook
Set wsFicAna = wbFicAna.ActiveSheet
' Vérifier que les fichiers A et B se trouvent dans le répertoire
If Dir(strRepFicA) = "" Or Dir(strRepFicB) = "" Then
MsgBox "Le fichier A et/ou le fichier B sont introuvables", vbCritical + vbOKOnly, "Problème de fichiers..."
Exit Sub
End If
Application.ScreenUpdating = False
' Ouverture du fichier A et définition de la feuille de traitement
Set wbFicA = Workbooks.Open(Filename:=strRepFicA)
Set wsFicA = wbFicA.Worksheets("A")
' Ouverture du fichier B et définition de la feuille de traitement
Set wbFicB = Workbooks.Open(Filename:=strRepFicB)
Set wsFicB = wbFicB.Worksheets("A")
' Vider les lignes du fichier d'analyse
wsFicAna.Range("A2:BN" & Cells.Rows.Count).ClearContents
' Première ligne d'affichage des résultats dans le fichier d'analyse
lgLigDeb = 10 - 1
' Traitement des lignes des 2 fichiers
Set dicoA = CreateObject("scripting.dictionary")
Set dicoB = CreateObject("scripting.dictionary")
' on crée une entrée dans le dictionnaire pour chaque ligne unique de B
dla = wsFicA.Cells(Rows.Count, 1).End(xlUp).Row
dlb = wsFicB.Cells(Rows.Count, 1).End(xlUp).Row
For lgLig = 2 To dlb
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 2eme fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicB.Cells(lgLig, lgCol)
Next lgCol
' si la clé n'existe pas on la sauve
If key <> "" Then
If Not dicoB.exists(key) Then
dicoB.Add key, lgLig
Else 'doublon détecté dans B
lgLigDeb = lgLigDeb + 1
lgLigB = dicoB.Item(key)
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name & "ligne " & lgLigB & "/" & lgLig
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy
wsFicAna.Range("B" & lgLigDeb).PasteSpecial xlPasteValues
End If
End If
Next lgLig
' on crée une entrée dans le dictionnaire pour chaque ligne unique de A
' on regarde si la ligne existe dans B, via le dictionnaire B
For lgLig = 2 To dla
' on construit la clé du dictionnaire en faisant parcourir à la boucle toutes les colonnes du 1er fichier de A à BN
key = ""
For lgCol = 1 To 67
key = key & wsFicA.Cells(lgLig, lgCol)
Next lgCol
If key <> "" Then
If Not dicoA.exists(key) Then
dicoA.Add key, lgLig
Else 'doublon détecté dans A
lgLigDeb = lgLigDeb + 1
lgLigB = dicoA.Item(key)
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name & "ligne " & lgLigB & "/" & lgLig
' Copier la ligne du fichier B dans le fichier d'analyse
wsFicA.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy
wsFicAna.Range("B" & lgLigDeb).PasteSpecial xlPasteValues
End If
If Not dicoB.exists(key) Then 'ligne de A n'existe pas dans B
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicA.Name
' Copier la ligne du fichier A dans le fichier d'analyse
wsFicA.Range("A" & lgLig & ":" & "BO" & lgLig).Copy
wsFicAna.Range("B" & lgLigDeb).PasteSpecial xlPasteValues
End If
End If
Next lgLig
For Each key In dicoB.keys 'on vérifie si les lignes de B existent dans A via le dictionnaire
If Not dicoA.exists(key) Then 'ligne de B n'existe pas dans A
' Affichage du nom du fichier en colonne A
lgLigDeb = lgLigDeb + 1
wsFicAna.Range("A" & lgLigDeb).Value = wbFicB.Name
' Copier la ligne du fichier B dans le fichier d'analyse
lgLigB = dicoB.Item(key)
wsFicB.Range("A" & lgLigB & ":" & "BO" & lgLigB).Copy
wsFicAna.Range("B" & lgLigDeb).PasteSpecial xlPasteValues
End If
Next key
' Fermer les fichiers A et B
wbFicA.Close savechanges:=False
wbFicB.Close savechanges:=False
MsgBox "Traitement terminé"
Application.ScreenUpdating = True
End SubBonjour,
Je suis parti vers une solution légèrement différente en utilisant des tableaux et la concaténation des valeurs dans des chaines puis comparaison des ces dernières. J'ai testé mon code mais seulement jusqu'à l'incorporation dans le tien (ou vice-versa) donc, à tester pour voir le résultat (si il y en a un sans bug bien sûr !). Il te faudra sûrement adapter :
Sub Test()
Dim wbFicA As Workbook, wbFicB As Workbook, wbFicAna As Workbook
Dim wsFicA As Worksheet, wsFicB As Worksheet, wsFicAna As Worksheet
Dim Tbl1, Tbl2
Dim TblResult() As String
Dim Plage As Range
Dim strRepFicA As String, strRepFicB As String
Dim Chaine1 As String, Chaine2 As String
Dim lgLigDeb As Long
Dim I As Long, J As Long, K As Long, L As Long, M As Long
'utilisation de la boite de dialogue FileDialog (ma préférence !)
With Application.FileDialog(3)
.Filters.Add "Fichiers Excel", "*.xls; *.xlsx; *.xlsm", 1
.Title = "Choisir le premier fichier à comparer"
If .Show = -1 Then strRepFicA = .SelectedItems(1)
.Title = "Choisir le second fichier à comparer"
If .Show = -1 Then strRepFicB = .SelectedItems(1)
End With
'si un des deux fichiers est manquant, fin de procédure
If strRepFicA = "" Or strRepFicB = "" Then MsgBox "Opération annulée !": Exit Sub
Set wbFicAna = ThisWorkbook
Set wsFicAna = wbFicAna.ActiveSheet
Application.ScreenUpdating = False
' Ouverture du fichier A et définition de la feuille de traitement
Set wbFicA = Workbooks.Open(strRepFicA)
Set wsFicA = wbFicA.Worksheets("A")
' Ouverture du fichier B et définition de la feuille de traitement
Set wbFicB = Workbooks.Open(strRepFicB)
Set wsFicB = wbFicB.Worksheets("A")
' Vider les lignes du fichier d'analyse
With wsFicAna: .Range(.Cells(2, 1), .Cells(Cells.Rows.Count, Cells.Columns.Count)).ClearContents: End With
' Première ligne d'affichage des résultats dans le fichier d'analyse
lgLigDeb = 10
'stocke les plages des deux feuilles dans des tableaux à partir de la ligne 2 et de la colonne A
Tbl1 = DefPlage(wsFicA, 2, 1).Value
Tbl2 = DefPlage(wsFicB, 2, 1).Value
'boucle primaire...
For I = 1 To UBound(Tbl1, 1)
'concaténation des valeurs de la ligne en cours sur la feuille "wsFicA" (Tbl1)
For J = 1 To UBound(Tbl1, 2)
Chaine1 = Chaine1 & Tbl1(I, J) & ";"
Next J
'boucle secondaire...
For K = 1 To UBound(Tbl2, 1)
'concaténation des valeurs de la ligne en cours sur la feuille "wsFicB" (Tbl2)
For L = 1 To UBound(Tbl2, 2)
Chaine2 = Chaine2 & Tbl2(K, L) & ";"
Next L
'comparaison des deux chaines, si différentes, stocke dans un tableau à 2 dimensions
'les noms des deux variables des feuilles ainsi que le numéro de chaque ligne et la chaine qui sera ensuite
'dipatshée dans les colonnes avec la méthode "TextToColumns"
If Chaine1 <> Chaine2 Then
M = M + 1
ReDim Preserve TblResult(1 To 3, 1 To M)
TblResult(1, M) = "Feuille 'wsFicA' du 1er fichier à la Ligne " & I
TblResult(2, M) = "Feuille 'wsFicB' du 2ème fichier à la Ligne " & K
TblResult(3, M) = Chaine2
End If
'réinitialise pour la prochaine ligne de la feuille "wsFicB" (Tbl2)
Chaine2 = ""
Next K
'réinitialise pour la prochaine ligne de la feuille "wsFicA" (Tbl1)
Chaine1 = ""
Next I
'inscription des résultats...
With wsFicAna
'à partir de la ligne 10...
.Range(.Cells(lgLigDeb, 1), .Cells(lgLigDeb + UBound(TblResult, 2), UBound(TblResult, 1))).Value = Application.Transpose(TblResult)
'défini la plage devant être dispatshée
Set Plage = DefPlage(wsFicAna, 1, 3)
'puis dispatsh
Plage.TextToColumns Plage(1, 1)
End With
' Fermer les fichiers A et B
wbFicA.Close False
wbFicB.Close False
MsgBox "Traitement terminé"
Application.ScreenUpdating = True
End Sub
Function DefPlage(Fe As Worksheet, L As Long, C As Long) As Range
On Error GoTo Fin
With Fe
Set DefPlage = .Range(.Cells(L, C), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
Exit Function
Fin:
Set DefPlage = Nothing
End Function