Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
Daniel
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal avancé
en trouvant d'autres modèles sur divers sites et je suis pas mal avancé,
presque à la fin d'ailleurs. Je cherche juste comment indiqué la durée de la
macro dans un msgbox. Ce que j'arrive à faire pour l'instant est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour dernière
cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour dernière
cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name 'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont pas
renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux fichiers,
Compar1.xlsm et Compar2.xlsm et notent les différences sur la feuille
"Différences" du classeur contenant la macro. Il reste à ajouter une boucle
pour ouvrir les paires de fichiers. Note que dans sa version actuelle, le
code considère que chaque feuille commence en ligne 1 et en colonne 1. On
peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count, f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta disposition
pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal avancé
en trouvant d'autres modèles sur divers sites et je suis pas mal avancé,
presque à la fin d'ailleurs. Je cherche juste comment indiqué la durée de la
macro dans un msgbox. Ce que j'arrive à faire pour l'instant est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour dernière
cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour dernière
cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name 'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont pas
renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
epCNigjsKHA.3800@TK2MSFTNGP06.phx.gbl...
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux fichiers,
Compar1.xlsm et Compar2.xlsm et notent les différences sur la feuille
"Différences" du classeur contenant la macro. Il reste à ajouter une boucle
pour ouvrir les paires de fichiers. Note que dans sa version actuelle, le
code considère que chaque feuille commence en ligne 1 et en colonne 1. On
peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count, f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta disposition
pour toute explication.
Daniel
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Bonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal avancé
en trouvant d'autres modèles sur divers sites et je suis pas mal avancé,
presque à la fin d'ailleurs. Je cherche juste comment indiqué la durée de la
macro dans un msgbox. Ce que j'arrive à faire pour l'instant est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour dernière
cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour dernière
cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name 'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont pas
renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux fichiers,
Compar1.xlsm et Compar2.xlsm et notent les différences sur la feuille
"Différences" du classeur contenant la macro. Il reste à ajouter une boucle
pour ouvrir les paires de fichiers. Note que dans sa version actuelle, le
code considère que chaque feuille commence en ligne 1 et en colonne 1. On
peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count, f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta disposition
pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Regarde l'aide VBA sur "Timer"
DanielBonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué la
durée de la macro dans un msgbox. Ce que j'arrive à faire pour l'instant
est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont
pas renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la
macro comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé
quelques exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Regarde l'aide VBA sur "Timer"
Daniel
Bonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué la
durée de la macro dans un msgbox. Ce que j'arrive à faire pour l'instant
est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont
pas renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
epCNigjsKHA.3800@TK2MSFTNGP06.phx.gbl...
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la
macro comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
Daniel
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé
quelques exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Regarde l'aide VBA sur "Timer"
DanielBonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué la
durée de la macro dans un msgbox. Ce que j'arrive à faire pour l'instant
est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont
pas renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la
macro comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé
quelques exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Je viens de regarder, mais toujours pareil, le format est moche 1,2322
Il faut sûrement le mettre en format, mais je ne trouve pas pour l'instant
DanielH
"Daniel.C" a écrit dans le message de news:
%Regarde l'aide VBA sur "Timer"
DanielBonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué la
durée de la macro dans un msgbox. Ce que j'arrive à faire pour l'instant
est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont pas
renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Je viens de regarder, mais toujours pareil, le format est moche 1,2322
Il faut sûrement le mettre en format, mais je ne trouve pas pour l'instant
DanielH
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23pMnjGlsKHA.5356@TK2MSFTNGP02.phx.gbl...
Regarde l'aide VBA sur "Timer"
Daniel
Bonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué la
durée de la macro dans un msgbox. Ce que j'arrive à faire pour l'instant
est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont pas
renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
epCNigjsKHA.3800@TK2MSFTNGP06.phx.gbl...
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
Daniel
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
Je viens de regarder, mais toujours pareil, le format est moche 1,2322
Il faut sûrement le mettre en format, mais je ne trouve pas pour l'instant
DanielH
"Daniel.C" a écrit dans le message de news:
%Regarde l'aide VBA sur "Timer"
DanielBonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué la
durée de la macro dans un msgbox. Ce que j'arrive à faire pour l'instant
est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont pas
renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur la
feuille "Différences" du classeur contenant la macro. Il reste à ajouter
une boucle pour ouvrir les paires de fichiers. Note que dans sa version
actuelle, le code considère que chaque feuille commence en ligne 1 et en
colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la macro
comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40 fichiers
chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé quelques
exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
MsgBox Format(debut, "mm:ss")
DanielJe viens de regarder, mais toujours pareil, le format est moche 1,2322
Il faut sûrement le mettre en format, mais je ne trouve pas pour
l'instant
DanielH
"Daniel.C" a écrit dans le message de news:
%Regarde l'aide VBA sur "Timer"
DanielBonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué
la durée de la macro dans un msgbox. Ce que j'arrive à faire pour
l'instant est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première
feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont
pas renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur
la feuille "Différences" du classeur contenant la macro. Il reste à
ajouter une boucle pour ouvrir les paires de fichiers. Note que dans
sa version actuelle, le code considère que chaque feuille commence en
ligne 1 et en colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la
macro comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40
fichiers chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé
quelques exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
MsgBox Format(debut, "mm:ss")
Daniel
Je viens de regarder, mais toujours pareil, le format est moche 1,2322
Il faut sûrement le mettre en format, mais je ne trouve pas pour
l'instant
DanielH
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
%23pMnjGlsKHA.5356@TK2MSFTNGP02.phx.gbl...
Regarde l'aide VBA sur "Timer"
Daniel
Bonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué
la durée de la macro dans un msgbox. Ce que j'arrive à faire pour
l'instant est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première
feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont
pas renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
epCNigjsKHA.3800@TK2MSFTNGP06.phx.gbl...
Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur
la feuille "Différences" du classeur contenant la macro. Il reste à
ajouter une boucle pour ouvrir les paires de fichiers. Note que dans
sa version actuelle, le code considère que chaque feuille commence en
ligne 1 et en colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la
macro comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
Daniel
Bonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40
fichiers chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé
quelques exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH
MsgBox Format(debut, "mm:ss")
DanielJe viens de regarder, mais toujours pareil, le format est moche 1,2322
Il faut sûrement le mettre en format, mais je ne trouve pas pour
l'instant
DanielH
"Daniel.C" a écrit dans le message de news:
%Regarde l'aide VBA sur "Timer"
DanielBonjour,
Merci pour la réponse. Je regarde les macros, mais je me suis pas mal
avancé en trouvant d'autres modèles sur divers sites et je suis pas mal
avancé, presque à la fin d'ailleurs. Je cherche juste comment indiqué
la durée de la macro dans un msgbox. Ce que j'arrive à faire pour
l'instant est un message
: 0,111254.
Encore merci.
DanielH
Au cas où je colle le résultat de mes efforts ci-dessous :
Sub Compare2Fichiers()
Dim Plg1 As Range, Plg2 As Range
Dim nomF1 As String, nomF2 As String, s As String
Dim cc As Range
Dim i As Integer
Depart = Time 'Now
'Ce classeur
CeClasseur = ThisWorkbook.Name
Début = Workbooks(CeClasseur).Sheets("Liste
différences").Range("A10").Address
'Mise à blanc du résultat
If Range("B8") > 0 Then
Range("A10:E" & Range("a65000").End(xlUp).Row).ClearContents
End If
'Sélection avec commentaire
Commentaire = Workbooks(CeClasseur).Sheets("Liste
différences").Range("Comment")
'nomF1 = "Fichier1.xls": nomF2 = "Fichier2.xls" ' à adapter
nomF1 = Range("B1").Value: nomF2 = Range("B2").Value ' à adapter
' Détermine les plages Plg1 et Plg2
Compteur = 0
If Workbooks.Count > 1 And Range("B1") <> "" Then
For i = 1 To Workbooks(nomF1).Worksheets.Count
Set Plg1 = Workbooks(nomF1).Sheets(i).Cells(1, 1) ' A1 première feuille
Set Plg1 = Range(Plg1, Plg1.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Set Plg2 = Workbooks(nomF2).Sheets(i).Cells(1, 1) 'A1 première
feuille
Set Plg2 = Range(Plg2, Plg2.SpecialCells(xlLastCell)) 'modif pour
dernière cellule
Feuille1 = Workbooks(nomF1).Sheets(i).Name
Feuille2 = Workbooks(nomF2).Sheets(i).Name
'MsgBox Plg2.Address
For Each cc In Plg1
If Not cc.HasFormula Then
If cc.Value <> Plg2.Range(cc.Address).Value Then
If Commentaire Then
'On Error Resume Next
cc.AddComment "Différent"
Plg2.Range(cc.Address).AddComment "Différent"
'Error = 0
End If
'on inscrit les références des fichiers
Range(Début).Select
Range(Début) = Workbooks(nomF1).Sheets(i).Name 'Feuille1
Range(Début).Offset(, 1) = Workbooks(nomF2).Sheets(i).Name
'Feuille2
Range(Début).Offset(, 2) = cc.Address
Range(Début).Offset(, 3) = cc.Value
Range(Début).Offset(, 4) = Plg2.Range(Michel.Address).Value
Début = Range(Début).Offset(1).Address
'pour compter le nombre de différences
Compteur = Compteur + 1
End If
End If
Next cc
Next i
MsgBox "il y a " & Compteur & "différences"
Fini = Now - Depart
MsgBox Fini
Else
MsgBox "Il n'y a qu'un classeur ouvert ou les noms en B1 et B2 ne sont
pas renseignés"
Fini = Time("00:00:00") - Depart
MsgBox Fini
End If
End Sub
"Daniel.C" a écrit dans le message de news:Bonjour.
Loin d'être complet ni testé; les macros suivantes comparent deux
fichiers, Compar1.xlsm et Compar2.xlsm et notent les différences sur
la feuille "Différences" du classeur contenant la macro. Il reste à
ajouter une boucle pour ouvrir les paires de fichiers. Note que dans
sa version actuelle, le code considère que chaque feuille commence en
ligne 1 et en colonne 1. On peut adapter.
- la macro Compar ouvre et ferme les paires de fichiers, appelle la
macro comparant les feuilles :
- ComparFeuilles compare les feuilles et appele la macro
- ComparCellules qui fait la comparaison cellule par cellule.
Public Ligne As Long
Sub Compar()
Dim Fich1 As Workbook, Fich2 As Workbook
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Différences")
Workbooks.Open "Compar1.xlsm"
Workbooks.Open "Compar2.xlsm"
Set Fich1 = Workbooks("Compar1.xlsm")
Set Fich2 = Workbooks("Compar2.xlsm")
Ligne = 0
ComparFeuilles Fich1, Fich2, sh
Workbooks("Compar1.xlsm").Close False
Workbooks("Compar2.xlsm").Close False
End Sub
Sub ComparFeuilles(f1 As Workbook, f2 As Workbook, sh As Worksheet)
Dim f As Worksheet
On Error Resume Next
With sh
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Classeurs :"
.Cells(Ligne, 2) = f1.Name
.Cells(Ligne, 3) = f2.Name
For Each f In f1.Sheets
Set test = f2.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 2) = f.Name
.Cells(Ligne, 3) = "absente"
Else
Var = f1.f.Name
ComparCellules f1.Sheets(f.Name), f2.Sheets(f.Name), sh
End If
Next f
For Each f In f2.Sheets
Set test = f1.Sheets(f.Name)
If Err.Number <> 0 Then
Err.Clear
Ligne = Ligne + 1
.Cells(Ligne, 1) = "Feuille"
.Cells(Ligne, 3) = f.Name
.Cells(Ligne, 2) = "absente"
End If
Next f
End With
On Error GoTo 0
End Sub
Sub ComparCellules(f1 As Worksheet, f2 As Worksheet, sh As Worksheet)
Dim h As Long, l As Integer, c As Range
h = Application.Max(f1.UsedRange.Rows.Count, f2.UsedRange.Rows.Count)
l = Application.Max(f1.UsedRange.Columns.Count,
f2.UsedRange.Columns.Count)
' implique que les deux feuilles commencent en ligne1 et en colonne 1
Var = Range(f1.Cells(1, 1), Cells(h, l))(1)
For Each c In Range(f1.Cells(1, 1), f1.Cells(h, l))
If c.Value <> f2.Range(c.Address) Then
Ligne = Ligne + 1
sh.Cells(Ligne, 1) = c.Address
sh.Cells(Ligne, 3) = f2.Range(c.Address).Value
sh.Cells(Ligne, 2) = c.Value
End If
Next c
End Sub
Le code n'est pas commenté dans un premier temps. Je reste à ta
disposition pour toute explication.
DanielBonjour,
J'ai un collègue qui rencontre un gros problème.
Il doit comparer 2 jeux (qui devraient être identiques) de 40
fichiers chacun, pour déceler les éventuelles différences.
Chaque fichier a un nombre d'onglets et de cellules différents.
J'ai regardé dans les anciens messages, et j'ai essayé de testé
quelques exemples, mais je me plante très vite.
Merci de vos prochaines réponses.
DanielH