Ajouter un commentaire si TRUE

Bonjour,

Dans la macro ci-dessous, je compare la valeur d'un plage de cellules de la Sheet01 (source) à cette même plage dans la Sheet02.

Si il y a une différence, je colore la cellule de la Sheet02 en jaune.

Pour gagner du temps, je souhaiterais, s'il y a une différence (cf : si la cellule est jaune), ajouter un commentaire avec la valeur source.

Exemple :

[Sheet01.C1] = "Guillaume" ET [Sheet02 .C1] = "Guillaum" alors [Sheet02.C1] = Interior.ColorIndex = 6 ET [Sheet02.C1.Commentaire] = Sheet01.C1.value

Option Explicit
Sub Comparaison()
Dim i As Long, j As Long, x As Range, dico As Object
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets(1).Cells(1).CurrentRegion
        For i = 1 To .Rows.Count
            dico(.Cells(i, 3).Value) = .Rows(i).Value
        Next
    End With

    With Sheets(2).Cells(1).CurrentRegion
        .Interior.ColorIndex = xlNone
        For i = 1 To .Rows.Count
            If dico.exists(.Cells(i, 3).Value) Then
                For j = 1 To .Columns.Count
                    If .Cells(i, j).Value <> dico(.Cells(i, 3).Value)(1, j) Then
                        If x Is Nothing Then
                            Set x = .Cells(i, j)
                        Else
                            Set x = Union(x, .Cells(i, j))
                        End If
                    End If
                Next
            End If
        Next
        If Not x Is Nothing Then x.Interior.ColorIndex = 6

'ma proposition
       If Not x.Comment Is Nothing Then x.AddComment
        x.Comment.Visible = True
        x.Comment.Text = Sheets(4).Cells(1).CurrentRegion
'J'ajoute un commentaire avec la valeur source de la cellule de la Sheet04 correspondante

    End With
    Application.ScreenUpdating = True
End Sub

Je vous remercie

Bonjour,

ce n'est pas facile de construire un fichier qui correspond à ton code; tu devrais ajouter un fichier anonymisé pour que ça facilite les choses

P.

Bonjour Patrick,

Tu as entièrement raison

NB : En me basant sur la colonne C (email address) comme Primary Key dans Sheet01 et Foreign Key dans Sheet02.

Ci-joint le fichier d'exemple.

Cordialement

Bonjour,

sur base de ton code..

essaye ceci

P.

Option Explicit
Sub DifférenceAvecCommentaires()
Dim i As Long, j As Long, x As Range, dico As Object
Dim Txt
Application.ScreenUpdating = False
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets(1).Cells(1).CurrentRegion
   For i = 2 To .Rows.Count
      dico(.Cells(i, 3).Value) = .Rows(i).Value
   Next
End With
With Sheets(2).Cells(1).CurrentRegion
   .Interior.ColorIndex = xlNone
   .ClearComments
   For i = 2 To .Rows.Count
      If dico.exists(.Cells(i, 3).Value) Then
         For j = 1 To .Columns.Count
            If .Cells(i, j).Value <> dico(.Cells(i, 3).Value)(1, j) Then
               Debug.Print dico(Cells(i, 3).Value)(1, j)
               If x Is Nothing Then
                  Txt = dico(Cells(i, 3).Value)(1, j)
                  Set x = .Cells(i, j)
                  Sheets(2).Cells(i, j).AddComment Text:=Txt
               Else
                  Txt = dico(Cells(i, 3).Value)(1, j)
                  Sheets(2).Cells(i, j).AddComment Text:=Txt
                  Set x = Union(x, .Cells(i, j))
               End If
            End If
         Next
      End If
   Next
   If Not x Is Nothing Then x.Interior.ColorIndex = 19

'ma proposition
'      If Not x.Comment Is Nothing Then x.AddComment
'        x.Comment.Visible = True
'        x.Comment.Text = Sheets(4).Cells(1).CurrentRegion
'J'ajoute un commentaire avec la valeur source de la cellule de la Sheet04 correspondante
End With
Application.ScreenUpdating = True
End Sub

Bonjour Patrick,

Je viens de tester cela fonctionne sur mon fichier de base mais il y a des erreurs lorsque j'ajoute des données.

Exemple :

• Sheet01 : consolidation de la feuille 03 - Feuille Source pour la macro
• Sheet02 : consolidation de la feuille 04 - Feuille à comparer pour la macro
• Sheet03 : Export des données "sources" dans cette feuille
• Sheet04 : Export des données "à comparer" dans cette feuille

Je souhaite comparer la Sheet01 à la Sheet02. J'ajoute 500 lignes. La macro fonctionne mais laisse passer des "coquilles" car j'ai modifier quelques valeurs et cela ne ressort pas.

ex : Sheet01.E12 = Italien et Sheet02.E12 = OK ==> Fonctionne bien

Sheet01.C16 = leonard.vinci@sport.com et Sheet02.C16 = OK ==> Ne fonctionne pas

Sheet01.B19 = OK et Sheet02.B19 = Leonard ==> Ne fonctionne pas

Pourtant avant l'ajout du paramètre "addComment", cela fonctionnnait peut importe le nb de colonnes/lignes en relevant toute différence dans la Sheet01 et la Sheet2.

As tu une idée ?

Cordialement

Bonjour Patrick,

J'ai édité mon post, car le paramètre ajouté présente des limites. J'ia joint un fichier d'exemple.

Cordialement