Comparer deux tableurs

Bonjour,

Je souhaite comparer 2 fichiers dont le nombre de ligne n'est pas identique (env. 10 sur 3500) mais j'ai constaté qu'il y avait des lignes dans un fichier et pas dans l'autre et vice-versa donc beaucoup d'erreur possible.

Qui peut m'aider ?

J'ai commencé une macro, mais je suis pas sur !

PJ : 3 fichiers pour m'expliquer.

Sub Macro1()
Dim derlignFeuil1 As Long, derlignFeuil2&, lim1&, lim2&, i&, j&, ind&
Dim tbl1, tbl2, tbl3()

'dernière ligne de la feuille "Feuil1"
derlignFeuil1 = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'dernière ligne de la feuille "Feuil2"
derlignFeuil2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
'on met toutes les données dans 2 variables tableau
tbl1 = Sheets("Feuil1").Range("A1:H" & derlignFeuil1)
tbl2 = Sheets("Feuil2").Range("A1:H" & derlignFeuil2)
lim1 = UBound(tbl1): lim2 = UBound(tbl2)

'on crée un tableau contenant toutes les ressources
ReDim tbl3(1 To lim1 + lim2, 1 To 2)
For i = 1 To lim1
j = j + 1
tbl3(j, 1) = tbl1(i, 1)
Next i
For i = 1 To lim2
j = j + 1
tbl3(j, 1) = tbl2(i, 1)
Next i

'on crée une liste sans doublons des id ressource
Set d = CreateObject("Scripting.Dictionary")
For i = LBound(tbl3) To UBound(tbl3)
d(tbl3(i, 1)) = ""
Next i
With Sheets("Feuil3")
.Rows("2:" & Rows.Count).ClearContents 'on efface les données
.[A2].Resize(d.Count, 1) = Application.Transpose(d.keys) 'on met les id en colonne A

'on récupère les infos
'l'utilisation de l'objet Dictionary permet un gain de performance dans notre cas
For ind = 2 To 8
Set temp = CreateObject("Scripting.Dictionary")
Set temp2 = CreateObject("Scripting.Dictionary")
For i = 1 To lim1
temp(tbl1(i, 1)) = tbl1(i, ind)
Next i
For i = 1 To lim2
temp2(tbl2(i, 1)) = tbl2(i, ind)
Next i

Set d = CreateObject("Scripting.Dictionary")
For i = LBound(tbl3) To UBound(tbl3)
If Not temp.exists(tbl3(i, 1)) Or temp(tbl3(i, 1)) = "" Then d(tbl3(i, 1)) = temp2(tbl3(i, 1)) Else d(tbl3(i, 1)) = temp(tbl3(i, 1))
Next i
Set temp = Nothing
Set temp2 = Nothing
.[A2].Offset(, ind - 1).Resize(d.Count, 1) = Application.Transpose(d.items)
Set d = Nothing
Next ind
.[A1].Sort Key1:=.[A2], Order1:=xlAscending, Header:=xlGuess 'tri

Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Rows("1:1").Select
Selection.Delete Shift:=xlUp

End With

End Sub

Merci d'avance.

15feuil1.xls (14.50 Ko)
13feuil2.xls (14.50 Ko)
16macro-1.zip (13.47 Ko)

Bonjour,

Que désires tu?

Le plus simple pour moi:

1 - tu ajoute une colonne en A de chaque fichier

2 - Tu remplis avec des 1 pour le fichier1 et avec des 2 pour le fichier2

3 - Tu copies toutes tes données dans un même onglet

4 - Tu tries, tu filtres sans doublons, tu fait un TCD, .......

Sinon, précise ce que tu veux.

Bonjour à tous

Un essai à tester. Te convient-il ?

Bye !

11macro-1-v1.zip (20.60 Ko)
Rechercher des sujets similaires à "comparer deux tableurs"