Comparaison entre classeur ouvert et original avant enregistrement.

[Broch002]

Bonjour, le forum.

J'ai un classeur (original) qui comporte une feuille qui me sert à synthétiser tous les tarifs des clients.
Lorsque je modifie les tarifs, les valeurs modifiées remontent dans le feuille de synthèse.
Je cherche à ce qu'au moment de l'enregistrer et d'écraser l'original, une macro me remonte dans une feuille sur le classeur ouvert, les modifications entre l'original et la version que je cherche à enregistrer.
Le classeur Original étant enregistré comme modèles Excel. Il se trouve en C:documents/clients/plan de vente.

Je joins deux classeurs pour faciliter la compréhension de mon problème, l'originale et celui "Nouveau" qui comporte la feuille qui doit remonter les modifications avec l'original.

j'ai cherché sur le net, et n'ai pas réussi à adapter ce que j'ai trouvé.

Merci de votre aide.

Broch002

 

[Broch002]

Re : Comparaison entre classeur ouvert et original avant enregistrement.

Bonjour, le forum.

J'ai un classeur (original) qui comporte une feuille qui me sert à synthétiser tous les tarifs des clients.
Lorsque je modifie les tarifs, les valeurs modifiées remontent dans le feuille de synthèse.
Je cherche à ce qu'au moment de l'enregistrer et d'écraser l'original, une macro me remonte dans une feuille sur le classeur ouvert, les modifications entre l'original et la version que je cherche à enregistrer.
Le classeur Original étant enregistré comme modèles Excel. Il se trouve en C:documents/clients/plan de vente.

Je joins deux classeurs pour faciliter la compréhension de mon problème, l'originale et celui "Nouveau" qui comporte la feuille qui doit remonter les modifications avec l'original.

j'ai cherché sur le net, et n'ai pas réussi à adapter ce que j'ai trouvé.

Merci de votre aide.

Broch002

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

 

[Broch002]

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

 

[Broch002]

Re : Comparaison entre classeur ouvert et original avant enregistrement.

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

Bonsoir à tous.

Aucune proposition, j'en déduis que ce ne doit pas être possible.

Bonne soirée.

Broche002

 

[Staple1600]

Re : Comparaison entre classeur ouvert et original avant enregistrement.

Bonsoir à tous

Si c'est possible
C'est juste une question de syntaxe
Créé deux classeurs vierges (sans les enregistrer)
Dans le Classeur1, copie dans un module le code ci-dessous puis lances la macro ExempleComparaison
En espérant que cela t'inspirera pour solutionner ta question

Sub ExempleComparaison()
Dim FichierA As Workbook
Dim FichierB As Workbook
Set FichierA = ThisWorkbook
Set FichierB = Workbooks("Classeur2")
Dim Dlig&, Col&, i&
Col = 1
'/////////////////////////ici juste pour création TEST////////////////////////////
FichierA.Sheets(1).Range("A1:A5") = Application.Transpose(Array(1, 2, 3, 4, 5))
FichierB.Sheets(1).Range("A1:A5") = Application.Transpose(Array(1, 2, 6, 4, 7))
'/////////////////////////////////////////////////////////////////////////////////
Dlig = FichierA.Sheets(1).Cells(Rows.Count, Col).End(3).Row
For i = 1 To Dlig
If FichierB.Sheets(1).Cells(i, Col).Value <> FichierA.Sheets(1).Cells(i, Col).Value Then
With FichierB.Sheets(1).Cells(i, Col)
MsgBox "en: " & .Address & vbCrLf & "valeur: " & .Value, vbInformation, "Différences constatées" & Space(8)
End With
End If
Next
End Sub

 

[Broch002]

Re : Comparaison entre classeur ouvert et original avant enregistrement.

Bonsoir à tous

Si c'est possible
C'est juste une question de syntaxe
Créé deux classeurs vierges (sans les enregistrer)
Dans le Classeur1, copie dans un module le code ci-dessous puis lances la macro ExempleComparaison
En espérant que cela t'inspirera pour solutionner ta question

Sub ExempleComparaison()
Dim FichierA As Workbook
Dim FichierB As Workbook
Set FichierA = ThisWorkbook
Set FichierB = Workbooks("Classeur2")
Dim Dlig&, Col&, i&
Col = 1
'/////////////////////////ici juste pour création TEST////////////////////////////
FichierA.Sheets(1).Range("A1:A5") = Application.Transpose(Array(1, 2, 3, 4, 5))
FichierB.Sheets(1).Range("A1:A5") = Application.Transpose(Array(1, 2, 6, 4, 7))
'/////////////////////////////////////////////////////////////////////////////////
Dlig = FichierA.Sheets(1).Cells(Rows.Count, Col).End(3).Row
For i = 1 To Dlig
If FichierB.Sheets(1).Cells(i, Col).Value <> FichierA.Sheets(1).Cells(i, Col).Value Then
With FichierB.Sheets(1).Cells(i, Col)
MsgBox "en: " & .Address & vbCrLf & "valeur: " & .Value, vbInformation, "Différences constatées" & Space(8)
End With
End If
Next
End Sub

Bonjour,

J'ai adapté votre code et la comparaison fonctionne bien sur la colonne 1, comment faire pour vérifier toutes les colonnes et cellules comportant une valeur (pour éviter de vérifier toute la feuille, trop lourd).
Le fichier a comparer, étant le fichier 'modèle de document' se trouve sur le disque en C:\Users\mon nom\Desktop\
je ne sais pas comment renseigner l'adresse dans votre code.

Merci de votre aide

Broch002