[E-03] Comparer 2 fichiers excel cellule par cellule

Version imprimable

22/10/2008, 22h15
Froggy007

[E-03] Comparer 2 fichiers excel cellule par cellule

Bonjour,

Je cherche un code VBA qui me permettrait de comparer le contenu de toutes les cellules de deux fichiers excel (afin de pouvoir suivre quels changements ont été réalisés entre les différentes versions d'un fichier).

Il s'agirait donc de comparer :
(Fichier 1/Feuille 1/Cellule 1) avec (Fichier 2/Feuille 1/Cellule 1)
(Fichier 1/Feuille 1/Cellule 2) avec (Fichier 2/Feuille 1/Cellule 2)
...
(Fichier 1/Feuille Z/Cellule Z) avec (Fichier 2/Feuille Z/Cellule Z)

Et lorsque la cellule du fichier 2 est différente, mettre son fond en Rose fluo par exemple.

Merci d'avance pour votre aide :)
23/10/2008, 11h18
decondelite

Tu fais 2 boucles imbriquées: une qui parcourt les lignes, et une qui parcourt les colonnes du premier fichier et tu testes les cellules une à une.

Tu as plein de tutos et FAQ qui peuvent répondre à ta question avec du code de parcours des lignes et des colonnes.
23/10/2008, 15h19
cafeine

Hello,

tout dépend si c'est ponctuel ou récurrent, si c'est ponctuel le plus simple reste à faire un troisième fichier avec :

Code:

=Classeur1.xls!Feuil1!A1=Classeur2.xls!Feuil1!A1

et recopier vers le bas et la droite
23/10/2008, 20h56
Froggy007

C'est un problème récurrent et avec de nombreuses feuilles renfermant beaucoup d'informations (formules et libellés) ...
24/10/2008, 09h06
decondelite

Ce qu'il veut dire, c'est que si ton problème ne concerne que 2 classeurs bien déterminés, la solution est plus simple et est celle qu'il propose.

Sinon, il faut y aller à la "hardcore style" comme je te l'ai proposé; ;)

Merci Decondelite et Cafeine :)

Pour ceux que ça interesserait je recopie le code que j'ai mis au point ci-dessous :

Code:

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
73
74
75
76
77
78
Sub ComparerCelluleParCellule()
 
    Dim wb1, wb2, wb3 As Workbook
    Dim Path, File1, File2, File3 As String
    Dim i, j, k As Integer
    Dim LastRow, LastCol As Integer
    Dim Formule1, Formule2 As String
    Dim NewR, NewC As Integer
 
    Path = "C:\Data\"
    File1 = "Fichier_1.xls"
    File2 = "Fichier_2.xls"
    File3 = "Comparer Ancienne et Nouvelle Versions.xls"
 
  ' S'assurer que les workbooks à traiter sont ouverts    
    If IsFileOpen(Path + File1) = False Then
        Workbooks.Open (Path + File1)
    End If
    If IsFileOpen(Path + File2) = False Then
        Workbooks.Open (Path + File2)
    End If
 
    Set wb1 = Workbooks(File1)
    Set wb2 = Workbooks(File2)
    Set wb3 = Workbooks(File3)
 
  ' Affiche le nombre de feuilles à traiter    
    MsgBox "Fichier ==> " & File1 & "// NbFeuilles : " & wb1.Sheets.Count
 
  ' Intialise un compteur des lignes où seront affichés les extractions
    NewR = 1
 
 
    For i = 1 To wb1.Sheets.Count
 
      ' Pour ne pas traiter chacune des 65 000 cellules d'un fichier excel
      ' on détermine dernière colonne et dernière ligne réellement utilisées 
      ' dans chacune des feuilles à traiter
        LastRow = wb1.Sheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
        LastCol = Workbooks(File1).Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Column
 
      ' Affiche la dernière ligne et dernière colonne utilisée de la feuille en cours de traitement
        MsgBox "LastRow : " & LastRow & " // LastCol : " & LastCol
 
' j boucle sur les lignes
' k boucle sur les colonnes
 
        For j = 1 To LastRow
            For k = 1 To LastCol
                If wb1.Sheets(i).Cells(j, k).Formula <> wb2.Sheets(i).Cells(j, k).Formula Then
 
                  ' Pour affichage à l'écran des divergences trouvées
                  ' supprimer les côtes des lignes de commentaires
 
                  ' MsgBox "R: " & j & Chr(10) & _
                  ' "C: " & k & Chr(10) & _
                  ' Chr(10) & _
                  ' "Old version : " & Chr(10) & _
                  ' "   " & wb1.Sheets(i).Cells(j, k).Formula & Chr(10) & _
                  ' " -----------------------------------------" & Chr(10) & _
                  ' "New version : " & Chr(10) & _
                  ' "   " & wb2.Sheets(i).Cells(j, k).Formula
                    wb1.Sheets(i).Cells(j, k).Interior.ColorIndex = 7
                    wb2.Sheets(i).Cells(j, k).Interior.ColorIndex = 7
 
              ' Écrire les divergences dans un nouveau fichier excel                    
                    wb3.Sheets(1).Cells(NewR, 1).Value = "'" & wb1.Sheets(i).Name & " // Row: " & j & " Col: " & k
                    wb3.Sheets(1).Cells(NewR, 2).Value = "'" & wb1.Sheets(i).Cells(j, k).Formula
                    wb3.Sheets(1).Cells(NewR, 3).Value = "'" & wb2.Sheets(i).Cells(j, k).Formula
 
                    NewR = NewR + 1
 
                End If
            Next k
        Next j
    Next i
 
End Sub

@lp