Bonjour à tous,
J'occupe un poste de PMO dans une boite pour laquelle je fais des reportings mensuels sur l'activité.
Aussi, j'ai souvent besoin d'expliquer des écarts entre l'etat M et M-1 (chose compliquée sur des fichier financier avec plus de 60 colonnes).
J'ai déjà trouvé une macro permettant de comparer la feuille correspondant à l'etat du mois M et M-1, le problème c'est que cette dernière compare ligne à ligne.
Elle fonctionne parfaitement et j'adore l'esprit de la macro, je voudrais juste qu'elle soit "intélligente" car d'un mois à l'autre les lignes ne sont pas forcement dans le même ordre.
J'ai bien pensé à faire un tri croissant ou décroissant sur ma première colonne pour avoir les ID dans le même ordre mais d'un mois a l'autre une ligne peut disparaitre et créer une distortion dans la comparaison.
Je pense que la clé de voute est d'intégrer un vlookup dans le code afin qu'elle sache quelle ligne comparer avec quelle ligne mais je ne comprend pas assez le code pour la modifier moi même.
Je vous met ci dessous le code de ma macro "non intélligente" car elle ne sait pas identifier une ligne par son ID.
Pour info mes identifiants sont en colonne A.
Sub ComparaisonMvsM-1()
Dim file1
Dim file2
Dim tab1
Dim tab2
Dim W1 As Workbook
Dim W2 As Workbook
Dim W3 As Workbook
Dim x
Dim comp
'file1 = Application.GetOpenFilename("Fichier Excel (*.XLS),*.XLS", , "Fichier de référence pour la comparaison", , False)'PC
file1 = Application.GetOpenFilename("XLS4,XLS8", , "Fichier de référence pour la comparaison", , False) 'Mac
If file1 <> False Then
'file2 = Application.GetOpenFilename("Fichier Excel (*.XLS),*.XLS", , "Fichier candidat pour la comparaison", , False)'PC
file2 = Application.GetOpenFilename("XLS4,XLS8", , "Fichier candidat pour la comparaison", , False) 'Mac
If file2 <> False Then
Set W1 = Workbooks.Open(file1, False, True, , "", "", True)
i = 0
For Each o In W1.Sheets
i = i + 1
S1 = S1 & i & " : " & o.Name & Chr(13)
Next
tab1 = 0
While tab1 < 1 Or tab1 > W1.Sheets.Count
tab1 = ""
While Not IsNumeric(tab1)
tab1 = InputBox(S1, "Quel onglet dans le fichier de référence ?", 1)
Wend
tab1 = Val(tab1)
Wend
If file1 <> file2 Then
Set W2 = Workbooks.Open(file2, False, True, , "", "", True)
Else
Set W2 = W1
End If
i = 0
For Each o In W2.Sheets
i = i + 1
S2 = S2 & i & " : " & o.Name & Chr(13)
Next
tab2 = 0
While tab2 < 1 Or tab2 > W2.Sheets.Count
tab2 = ""
While Not IsNumeric(tab2)
tab2 = InputBox(S2, "Quel onglet dans le fichier candidat ?", 1)
Wend
tab2 = Val(tab2)
Wend
Application.Interactive = False
Application.ScreenUpdating = False
x = InputBox("1 : rouge" & Chr(13) & "2 : cadre rouge" & Chr(13) & "3 : 1 et 2", "Type de mise en valeur", 1)
If Not IsNumeric(x) Then x = "3"
If x < "1" Then x = "1"
If x > "3" Then x = "3"
x = Val(x)
Application.DisplayAlerts = False
Set W3 = Workbooks.Add()
While W3.Sheets.Count > 1
W3.Sheets(1).Delete
Wend
W1.Sheets(tab1).Copy before:=W3.Sheets(W3.Sheets.Count)
W2.Sheets(tab2).Copy before:=W3.Sheets(W3.Sheets.Count)
W3.Sheets(2).Copy before:=W3.Sheets(W3.Sheets.Count)
W3.Sheets(2).Copy before:=W3.Sheets(W3.Sheets.Count)
W3.Sheets(1).Name = Left("Référence (" & W1.Name & ")", 31)
W3.Sheets(2).Name = Left("Candidat (" & W2.Name & ")", 31)
W3.Sheets(3).Name = "Comparaison"
W3.Sheets(4).Name = "Ecarts"
W1.Close False
If file1 <> file2 Then
W2.Close False
End If
W3.Sheets(W3.Sheets.Count).Delete
Application.DisplayAlerts = True
With W3.Sheets("Ecarts").Cells
.ClearContents
.Font.Color = RGB(200, 200, 200)
End With
If x = 3 Then W3.Sheets("Comparaison").Cells.Font.Color = RGB(200, 200, 200)
For c = 1 To W3.Sheets("Comparaison").Cells(1).SpecialCells(xlCellTypeLastCell).Column
For l = 1 To W3.Sheets("Comparaison").Cells(1).SpecialCells(xlCellTypeLastCell).Row
On Error Resume Next
comp = (W3.Sheets(1).Cells(l, c) <> W3.Sheets(2).Cells(l, c))
If Err.Number > 0 Then
comp = True
End If
On Error GoTo 0
If comp Then
With W3.Sheets("Comparaison").Cells(l, c)
If x = 1 Or x = 3 Then .Font.Color = RGB(255, 0, 0)
If x = 2 Or x = 3 Then .Borders.Color = RGB(255, 0, 0)
If x = 2 Or x = 3 Then .Borders.Weight = xlThick
End With
With W3.Sheets("Ecarts").Cells(l, c)
.Font.Color = RGB(255, 0, 0)
If IsNumeric(W3.Sheets(2).Cells(l, c)) And IsNumeric(W3.Sheets(1).Cells(l, c)) Then
.Value = W3.Sheets(2).Cells(l, c) - W3.Sheets(1).Cells(l, c)
.NumberFormat = "+ General;- General"
Else
.Value = W3.Sheets(2).Cells(l, c)
End If
End With
Else
If IsNumeric(W3.Sheets(2).Cells(l, c)) Then
W3.Sheets("Ecarts").Cells(l, c) = 0
Else
W3.Sheets("Ecarts").Cells(l, c) = W3.Sheets(2).Cells(l, c)
End If
End If
Next
Next
W3.Sheets("Comparaison").Activate
Application.Interactive = True
Application.ScreenUpdating = True
End If
End If
End Sub
Merci enormement par avance car toute aide est bienvenue.
Vous n'imaginez pas le temps que votre savoir pourrait me faire gagner chaque mois.
J'occupe un poste de PMO dans une boite pour laquelle je fais des reportings mensuels sur l'activité.
Aussi, j'ai souvent besoin d'expliquer des écarts entre l'etat M et M-1 (chose compliquée sur des fichier financier avec plus de 60 colonnes).
J'ai déjà trouvé une macro permettant de comparer la feuille correspondant à l'etat du mois M et M-1, le problème c'est que cette dernière compare ligne à ligne.
Elle fonctionne parfaitement et j'adore l'esprit de la macro, je voudrais juste qu'elle soit "intélligente" car d'un mois à l'autre les lignes ne sont pas forcement dans le même ordre.
J'ai bien pensé à faire un tri croissant ou décroissant sur ma première colonne pour avoir les ID dans le même ordre mais d'un mois a l'autre une ligne peut disparaitre et créer une distortion dans la comparaison.
Je pense que la clé de voute est d'intégrer un vlookup dans le code afin qu'elle sache quelle ligne comparer avec quelle ligne mais je ne comprend pas assez le code pour la modifier moi même.
Je vous met ci dessous le code de ma macro "non intélligente" car elle ne sait pas identifier une ligne par son ID.
Pour info mes identifiants sont en colonne A.
Sub ComparaisonMvsM-1()
Dim file1
Dim file2
Dim tab1
Dim tab2
Dim W1 As Workbook
Dim W2 As Workbook
Dim W3 As Workbook
Dim x
Dim comp
'file1 = Application.GetOpenFilename("Fichier Excel (*.XLS),*.XLS", , "Fichier de référence pour la comparaison", , False)'PC
file1 = Application.GetOpenFilename("XLS4,XLS8", , "Fichier de référence pour la comparaison", , False) 'Mac
If file1 <> False Then
'file2 = Application.GetOpenFilename("Fichier Excel (*.XLS),*.XLS", , "Fichier candidat pour la comparaison", , False)'PC
file2 = Application.GetOpenFilename("XLS4,XLS8", , "Fichier candidat pour la comparaison", , False) 'Mac
If file2 <> False Then
Set W1 = Workbooks.Open(file1, False, True, , "", "", True)
i = 0
For Each o In W1.Sheets
i = i + 1
S1 = S1 & i & " : " & o.Name & Chr(13)
Next
tab1 = 0
While tab1 < 1 Or tab1 > W1.Sheets.Count
tab1 = ""
While Not IsNumeric(tab1)
tab1 = InputBox(S1, "Quel onglet dans le fichier de référence ?", 1)
Wend
tab1 = Val(tab1)
Wend
If file1 <> file2 Then
Set W2 = Workbooks.Open(file2, False, True, , "", "", True)
Else
Set W2 = W1
End If
i = 0
For Each o In W2.Sheets
i = i + 1
S2 = S2 & i & " : " & o.Name & Chr(13)
Next
tab2 = 0
While tab2 < 1 Or tab2 > W2.Sheets.Count
tab2 = ""
While Not IsNumeric(tab2)
tab2 = InputBox(S2, "Quel onglet dans le fichier candidat ?", 1)
Wend
tab2 = Val(tab2)
Wend
Application.Interactive = False
Application.ScreenUpdating = False
x = InputBox("1 : rouge" & Chr(13) & "2 : cadre rouge" & Chr(13) & "3 : 1 et 2", "Type de mise en valeur", 1)
If Not IsNumeric(x) Then x = "3"
If x < "1" Then x = "1"
If x > "3" Then x = "3"
x = Val(x)
Application.DisplayAlerts = False
Set W3 = Workbooks.Add()
While W3.Sheets.Count > 1
W3.Sheets(1).Delete
Wend
W1.Sheets(tab1).Copy before:=W3.Sheets(W3.Sheets.Count)
W2.Sheets(tab2).Copy before:=W3.Sheets(W3.Sheets.Count)
W3.Sheets(2).Copy before:=W3.Sheets(W3.Sheets.Count)
W3.Sheets(2).Copy before:=W3.Sheets(W3.Sheets.Count)
W3.Sheets(1).Name = Left("Référence (" & W1.Name & ")", 31)
W3.Sheets(2).Name = Left("Candidat (" & W2.Name & ")", 31)
W3.Sheets(3).Name = "Comparaison"
W3.Sheets(4).Name = "Ecarts"
W1.Close False
If file1 <> file2 Then
W2.Close False
End If
W3.Sheets(W3.Sheets.Count).Delete
Application.DisplayAlerts = True
With W3.Sheets("Ecarts").Cells
.ClearContents
.Font.Color = RGB(200, 200, 200)
End With
If x = 3 Then W3.Sheets("Comparaison").Cells.Font.Color = RGB(200, 200, 200)
For c = 1 To W3.Sheets("Comparaison").Cells(1).SpecialCells(xlCellTypeLastCell).Column
For l = 1 To W3.Sheets("Comparaison").Cells(1).SpecialCells(xlCellTypeLastCell).Row
On Error Resume Next
comp = (W3.Sheets(1).Cells(l, c) <> W3.Sheets(2).Cells(l, c))
If Err.Number > 0 Then
comp = True
End If
On Error GoTo 0
If comp Then
With W3.Sheets("Comparaison").Cells(l, c)
If x = 1 Or x = 3 Then .Font.Color = RGB(255, 0, 0)
If x = 2 Or x = 3 Then .Borders.Color = RGB(255, 0, 0)
If x = 2 Or x = 3 Then .Borders.Weight = xlThick
End With
With W3.Sheets("Ecarts").Cells(l, c)
.Font.Color = RGB(255, 0, 0)
If IsNumeric(W3.Sheets(2).Cells(l, c)) And IsNumeric(W3.Sheets(1).Cells(l, c)) Then
.Value = W3.Sheets(2).Cells(l, c) - W3.Sheets(1).Cells(l, c)
.NumberFormat = "+ General;- General"
Else
.Value = W3.Sheets(2).Cells(l, c)
End If
End With
Else
If IsNumeric(W3.Sheets(2).Cells(l, c)) Then
W3.Sheets("Ecarts").Cells(l, c) = 0
Else
W3.Sheets("Ecarts").Cells(l, c) = W3.Sheets(2).Cells(l, c)
End If
End If
Next
Next
W3.Sheets("Comparaison").Activate
Application.Interactive = True
Application.ScreenUpdating = True
End If
End If
End Sub
Merci enormement par avance car toute aide est bienvenue.
Vous n'imaginez pas le temps que votre savoir pourrait me faire gagner chaque mois.
