Bonjour à tous!
J'essaye de coder un petit programme de comparaison de données entre tableaux.
Comme on peut le voir dans le fichier joint, les deux tableaux comportent des références et des données associées.
J'aimerais que la macro effectue une comparaison des références (Ref), lorsque les références sont identiques alors les Pu sont comparés et lorsqu'ils sont différents alors le Pu de la Feuil1 est surligné en rouge et un commentaire apparais montrant l'écart entre les deux Pu.
La phase de comparaison m'a déjà été fournie sur ce forum, elle est sous la forme:
Sub MisAJour()
Dim DerLig1 As Long, DerLig2 As Long, i As Long, j As Long, TabIni, TabRef
DerLig1 = Worksheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Row
DerLig2 = Worksheets("Feuil2").Range("B" & Rows.Count).End(xlUp).Row
TabIni = Worksheets("Feuil1").Range("C2:E" & DerLig1)
TabRef = Worksheets("Feuil2").Range("B2:E" & DerLig2)
For i = LBound(TabRef) To UBound(TabRef)
For j = LBound(TabIni) To UBound(TabIni)
If TabRef(i, 1) = TabIni(j, 1) Then
ACTION
Exit For
End If
Next
Next
Worksheets("Feuil1").Range("C2").Resize(UBound(TabIni, 1), UBound(TabIni, 2)) = TabIni
End Sub
Mais je coince au niveau de l'action, je ne sais pas comment indiquer la CASE en cours (j) ni comment indiquer l'écart variable dans le commentaire.
ACTION:
Range("CASE").AddComment
Range("CASE").Comment.Visible = False
Range("CASE").Comment.Text Text:="ECART:" & Chr(10) & ""
Range("CASE").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
De plus, si c'est possible, j'aimerais que la macro efface les commentaires possiblement présent sur une CASE si l'écart entre les Pu n'existe plus.
Si quelqu'un a déjà rencontré cette problématique et qu'il a une solution envisageable, je suis preneur!
Merci à vous pour votre aide!
J'essaye de coder un petit programme de comparaison de données entre tableaux.
Comme on peut le voir dans le fichier joint, les deux tableaux comportent des références et des données associées.
J'aimerais que la macro effectue une comparaison des références (Ref), lorsque les références sont identiques alors les Pu sont comparés et lorsqu'ils sont différents alors le Pu de la Feuil1 est surligné en rouge et un commentaire apparais montrant l'écart entre les deux Pu.
La phase de comparaison m'a déjà été fournie sur ce forum, elle est sous la forme:
Sub MisAJour()
Dim DerLig1 As Long, DerLig2 As Long, i As Long, j As Long, TabIni, TabRef
DerLig1 = Worksheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Row
DerLig2 = Worksheets("Feuil2").Range("B" & Rows.Count).End(xlUp).Row
TabIni = Worksheets("Feuil1").Range("C2:E" & DerLig1)
TabRef = Worksheets("Feuil2").Range("B2:E" & DerLig2)
For i = LBound(TabRef) To UBound(TabRef)
For j = LBound(TabIni) To UBound(TabIni)
If TabRef(i, 1) = TabIni(j, 1) Then
ACTION
Exit For
End If
Next
Next
Worksheets("Feuil1").Range("C2").Resize(UBound(TabIni, 1), UBound(TabIni, 2)) = TabIni
End Sub
Mais je coince au niveau de l'action, je ne sais pas comment indiquer la CASE en cours (j) ni comment indiquer l'écart variable dans le commentaire.
ACTION:
Range("CASE").AddComment
Range("CASE").Comment.Visible = False
Range("CASE").Comment.Text Text:="ECART:" & Chr(10) & ""
Range("CASE").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
De plus, si c'est possible, j'aimerais que la macro efface les commentaires possiblement présent sur une CASE si l'écart entre les Pu n'existe plus.
Si quelqu'un a déjà rencontré cette problématique et qu'il a une solution envisageable, je suis preneur!
Merci à vous pour votre aide!
Pièces jointes
Dernière édition: