Comparer 2 fichiers Excel...

[azerty6767]

Bonjour,

J'ai parcouru le forum à ce sujet, et je ne trouve pas une réponse simple et claire.... puisque chacun a, à chaque fois, un cas particulier...


Ce que je souhaiterais faire :

A partir d'un fichier "coucou.xls", situé à l'adresse "C:\coucou\coucou.xls",

je souhaite comparer le contenu des cellules des 2 fichiers suivants :

C:\test\toto_rev0.xls
C:\test\toto_rev1.xls

Précision : les 2 fichiers toto_rev*.xls contiennent des données sur les colonnes A à H, et sur un nombre de lignes variable.


Dès qu'il y a une différence de contenu, les cellules du fichier toto_rev1.xls uniquement (pas toto_rev0) doivent être coloriées.

Question : est-on obligé d'ouvrir les 2 fichiers toto_rev*.xls afin de les comparer ?...




Merci d'avance pour votre aide précieuse,




Olivier

 

[job75]

Re : Comparer 2 fichiers Excel...

Bonjour azerty6767,

Une macro au pied levé que je vous laisse tester (je ne l'ai pas fait) :

Sub Compare()
Dim F$, plage As Range, cel As Range
F = "Feuil1" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Workbooks.Open "C:\test\toto_rev0.xls"
If Err Then MsgBox "toto_rev0.xls introuvable !": Exit Sub
Workbooks.Open "C:\test\toto_rev1.xls"
If Err Then MsgBox "toto_rev1.xls introuvable !": Exit Sub
Set plage = Workbooks("toto_rev1.xls").Sheets(F).UsedRange
plage.Interior.ColorIndex = xlNone 'effacement de toute couleur
With Workbooks("toto_rev0.xls").Sheets(F)
  For Each cel In plage
    If cel <> .Range(cel.Address) Then cel.Interior.ColorIndex = 3 'couleur rouge
  Next
End With
End Sub

L'ouverture des fichiers est indispensable, mais on peut bien sûr les refermer...

A+

 

[job75]

Re : Comparer 2 fichiers Excel...

Re,

Ceci est sans doute mieux :

Sub Compare()
Dim F$, plage0 As Range, plage As Range, cel As Range
F = "Feuil1" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Workbooks.Open "C:\test\toto_rev0.xls"
If Err Then MsgBox "toto_rev0.xls introuvable !": Exit Sub
Workbooks.Open "C:\test\toto_rev1.xls"
If Err Then MsgBox "toto_rev1.xls introuvable !": Exit Sub
[COLOR="Red"]Set plage0 = Workbooks("toto_rev0.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).Range(plage0.Address, plage)[/COLOR]
plage.Interior.ColorIndex = xlNone 'effacement de toute couleur
With Workbooks("toto_rev0.xls").Sheets(F)
  For Each cel In plage
    If cel <> .Range(cel.Address) Then cel.Interior.ColorIndex = 3 'couleur rouge
  Next
End With
End Sub

Nota : j'ai supposé que les feuilles étudiées dans les 2 fichiers ont le même nom, sinon adaptez...

A+

 

[azerty6767]

Re : Comparer 2 fichiers Excel...

Super, ça marche ! Merci,

Une dernière question concernant le code proposé :

pourquoi faire 2 "set plage" différents, et à la suite ?





Merci ,

 

[job75]

Re : Comparer 2 fichiers Excel...

Re,

J'aurais pu aussi bien écrire :

Set plage0 = Workbooks("toto_rev0.xls").Sheets(F).UsedRange
Set [COLOR="Red"]plage1[/COLOR] = Workbooks("toto_rev1.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).Range(plage0.Address, [COLOR="red"]plage1[/COLOR])

Avec le code proposé, j'économise la création de la variable plage1...

A+

 

[azerty6767]

Re : Comparer 2 fichiers Excel...

Bonsoir,

Tout fonctionne parfaitement.

Un point qui m'embête désormais, je souhaite enregistrer et fermer les classeurs "toto_rev0.xls" et "toto_rev1_xls".

(précision : si le fichier "toto_rev1.xls" n'existe pas - car il aura été "killé" (avec un autre petit bout de code (facile)) au cas où il n'a pas de différence entre les cellules de toto_rev0.xls et toto_rev1.xls -, seul le classeur toto_rev0 sera enregistré puis fermé)

J'ai écrit (dans la suite du code ci-dessus qui fonctionne bien) :

Workbooks.Open "C:\test\coucou.xls"

If Dir("C:\test\toto_rev1.xls") = "" Then
   Workbooks("toto_rev0.xls").SaveAs Filename:="C:\test\toto_rev0.xls",   FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    Workbooks("toto_rev0.xls").Close
Else
  Workbooks("toto_rev0.xls").SaveAs Filename:="C:\test\toto_rev0.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
  Workbooks("toto_rev1.xls").SaveAs Filename:="C:\test\toto_rev1.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        
  Workbooks("toto_rev0.xls").Close
  Workbooks("toto_rev1.xls").Close

Or VBA n'exécute pas le code ci-dessus ? J'ai oublié une adresse ? Ou une activation ? Je crois que la feuille active n'est plus "coucou.xls" : je me suis fait sortir du code directement...
N'étant pas un pro, je suis sûr que cela crèvera les yeux d'un utilisateur averti !



Merci d'avance pour votre aide et bon week-end,

 

[job75]

Re : Comparer 2 fichiers Excel...

Re,

A vrai dire, je pensais que le fichier coucou.xls était celui qui contenait la macro.

Comme vous voulez l'ouvrir, là je ne comprends plus rien

Pour fermer les 2 autres fichiers, pourquoi ne pas écrire simplement :

Sub Compare()
Dim F$, plage0 As Range, plage As Range, cel As Range
F = "Feuil1" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Workbooks.Open "C:\test\toto_rev0.xls"
If Err Then MsgBox "toto_rev0.xls introuvable !": [COLOR="Red"]GoTo 1[/COLOR]
Workbooks.Open "C:\test\toto_rev1.xls"
If Err Then MsgBox "toto_rev1.xls introuvable !": [COLOR="red"]GoTo 1[/COLOR]
Set plage0 = Workbooks("toto_rev0.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).Range(plage0.Address, plage)
plage.Interior.ColorIndex = xlNone 'effacement de toute couleur
With Workbooks("toto_rev0.xls").Sheets(F)
  For Each cel In plage
    If cel <> .Range(cel.Address) Then cel.Interior.ColorIndex = 3 'couleur rouge
  Next
End With
[COLOR="red"]1 Workbooks("toto_rev0.xls").Close
Workbooks("toto_rev1.xls").Close True 'ferme le fichier après l'avoir enregistré[/COLOR]
End Sub

A+

 

[azerty6767]

Re : Comparer 2 fichiers Excel...

Bonsoir,

Oui, je confirme : c'est dans coucou.xls que se trouve la macro
(sur la Feuil1 du classeur coucou.xls)

Je viens de voir à quoi c'est dû :

En fait, c'est le code suivant (made in moi-
même...) qui n'était pas bien placé :

----------------------------------------------
With Workbooks("toto_rev1.xls").Sheets(F)
For Each cel In plage1
If cel.Interior = 3 Then
MsgBox ("Une nouvelle révision a été créée : les cellules différentes sont coloriées en rouge")
Shell ("explorer c:\test\")
Exit Sub
ElseIf cel.Interior <> 3 Then
MsgBox ("Le nouveau fichier 'toto_rev1' ne comporte pas de différences par rapport à la dernière révision existante !")
Shell ("explorer c:\test\")
Kill "C:\test\toto_rev1.xls"
End If
Next
End With
---------------------------------


BREF !!

Bonne soirée,

 

[job75]

Re : Comparer 2 fichiers Excel...

Bonjour azerty6767,

Votre code ne semble pas convenir, voyez plutôt :

Sub Compare()
Dim F$, plage0 As Range, plage As Range, cel As Range, [COLOR="Red"]test1 As Boolean, test2 As Boolean[/COLOR]
F = "Feuil1" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Workbooks.Open "C:\test\toto_rev0.xls"
If Err Then MsgBox "toto_rev0.xls introuvable !": GoTo 1
Workbooks.Open "C:\test\toto_rev1.xls"
If Err Then MsgBox "toto_rev1.xls introuvable !": GoTo 1
Set plage0 = Workbooks("toto_rev0.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).UsedRange
Set plage = Workbooks("toto_rev1.xls").Sheets(F).Range(plage0.Address, plage)
plage.Interior.ColorIndex = xlNone 'effacement de toute couleur
With Workbooks("toto_rev0.xls").Sheets(F)
  For Each cel In plage
    If cel <> .Range(cel.Address) Then [COLOR="red"]test1 = True:[/COLOR] cel.Interior.ColorIndex = 3 'couleur rouge
  Next
End With
[COLOR="red"]test2 = Not test1[/COLOR]
1 Workbooks("toto_rev0.xls").Close
[COLOR="red"]Workbooks("toto_rev1.xls").Save 'enregistre le fichier
If Not test1 Then Workbooks("toto_rev1.xls").Close
Application.ScreenUpdating = True
If test1 Then MsgBox ("Une nouvelle révision a été créée : les cellules différentes sont coloriées en rouge")
If test2 Then
  MsgBox ("Le nouveau fichier 'toto_rev1' ne comporte pas de différences par rapport à la dernière révision existante !")
  Kill "C:\test\toto_rev1.xls"
End If[/COLOR]
End Sub

A+

 

[azerty6767]

Re : Comparer 2 fichiers Excel...

Bonsoir,

Merci beaucoup..!

Je vais tester la modif demain ; si pas de nouvelles, c'est que tout fonctionne !



Merci encore,





Olivier