Re : Comparaison entre classeur ouvert et original avant enregistrement.
Rebonjour,
Il n'y a pas de solution
Tout semble possible avec excel, mais là je ne trouve pas, je continue à chercher.
Bonne journée.
Broch002
J'ai trouvé cette macro, mais qui fonctionne entre deux feuilles du même classeur.
J'ai essayé de modifier le chemin du fichier, mais cela ne fonctionne pas.
En italique souligné, ce que j'ai modifié.
sub ComparaisonTableau()
Dim RG1 As Range, RG2 As Range
Dim Tblo1, Tblo2, Rg3 As Range
Dim A As Long, B As Integer, C As Long, D As Integer
Set RG1 = Sheets("Feuil1").Range("A1:A10") 'Tabeau 1
Set RG2 = Sheets("Feuil2").Range("A1:A10") 'Tableau 2[/I]
Set Rg3 = Sheets("Feuil3").Range("A1") 'Tableau des résultats
If RG1.Rows.Count <> RG2.Rows.Count Then
MsgBox "Le tableau n'a pas le même nombre de lignes"
exit sub
End If
If RG1.Columns.Count <> RG2.Columns.Count Then
MsgBox "Le tableau n'a pas le même nombre de colonnes"
exit sub
End If
Tblo1 = RG1: Tblo2 = RG2: D = 1
Application.ScreenUpdating = False
For A = 1 To UBound(Tblo1, 1)
For B = 1 To UBound(Tblo1, 2)
If Tblo1(A, B) <> Tblo2(A, B) Then
C = C + 1
Rg3(C, D) = RG1(A, B).Address(0, 0)
Rg3(C, D).Offset(, 1) = Tblo1(A, B)
Rg3(C, D).Offset(, 2) = RG2(A, B).Address(0, 0)
Rg3(C, D).Offset(, 3) = Tblo2(A, B)
End If
Next
Next
Set RG1 = Nothing: Set RG2 = Nothing: Set Rg3 = Nothing
Erase Tblo1: Erase Tblo2
end sub
Macro Modifiée:
Sub ComparaisonTableau()
Dim RG1 As Range, RG2 As Range
Dim Tblo1, Tblo2, Rg3 As Range
Dim A As Long, B As Integer, C As Long, D As Integer
Set RG1 = Sheets("Feuil1").Range("A1:BM10") 'Tabeau 1
Set RG2 = "C:\Users\mon nom\Desktop\Original.xlsx"
Sheets("Feuil1").SelectSelect.Range ("A1:BM10") 'Tableau 2
Set Rg3 = Sheets("Feuil3").Range("A1") 'Tableau des résultats
If RG1.Rows.Count <> RG2.Rows.Count Then
MsgBox "Le tableau n'a pas le même nombre de lignes"
Exit Sub
End If
If RG1.Columns.Count <> RG2.Columns.Count Then
MsgBox "Le tableau n'a pas le même nombre de colonnes"
Exit Sub
End If
Tblo1 = RG1: Tblo2 = RG2: D = 1
Application.ScreenUpdating = False
For A = 1 To UBound(Tblo1, 1)
For B = 1 To UBound(Tblo1, 2)
If Tblo1(A, B) <> Tblo2(A, B) Then
C = C + 1
Rg3(C, D) = RG1(A, B).Address(0, 0)
Rg3(C, D).Offset(, 1) = Tblo1(A, B)
Rg3(C, D).Offset(, 2) = RG2(A, B).Address(0, 0)
Rg3(C, D).Offset(, 3) = Tblo2(A, B)
End If
Next
Next
Set RG1 = Nothing: Set RG2 = Nothing: Set Rg3 = Nothing
Erase Tblo1: Erase Tblo2
End Sub
Merci d'avance.
Broch002