VBA pour comparer les lignes de deux tableaux en fonction d'une colonne
Bonjour à tous,
Après pleins de test je vosu écrit car je ne trouve pas la solution et que peut être je pourrais bénéficier de vos lumières. Vous trouverez ci joint mon fichier ainsi que le code.
La macro compare deux feuilles dans une feuille de synthèse :
-Copie les lignes de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
- Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
-Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
Mon problème concerne la partie ou les écarts sont colorés sur la feuille de synthèse car elle compare les lignes une à une , or je souhaiterai que celle ci compare les lignes en fonction de l'ID en colonne "K" mais je ne trouve pas comment faire .... :(
Merci de m'avoir lu , à votre dispo pour tout renseignement complémentaire
!
Bonne journée
A.
Option Explicit
Dim u, v, I, j, dico1, dico2, lgn
Sub Synthèse()
Dim Cel As Range
Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).Interior.Color = xlNone
Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
Application.ScreenUpdating = False
u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)
Set dico1 = CreateObject("Scripting.Dictionary")
Set dico2 = CreateObject("Scripting.Dictionary")
For I = 1 To UBound(u, 1)
dico1(u(I, 11)) = I
Next I
For I = 1 To UBound(v, 1)
dico2(v(I, 11)) = ""
Next I
For I = 1 To UBound(u, 1)
'on recopie les ligns de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
If dico2.exists(u(I, 11)) = False Then
lgn = Sheets("Synthèse").Range("A" & Rows.Count).End(xlUp)(2).Row
For j = 1 To UBound(u, 2)
Sheets("Synthèse").Cells(lgn, j) = u(I, j)
Next j
End If
Next I
For I = 1 To UBound(v, 1)
lgn = Sheets("Synthèse").Range("A" & Rows.Count).End(xlUp)(2).Row
If dico1.exists(v(I, 11)) Then
'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(I, j)
If u(I, j) <> v(I, j) Then
Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
End If
Next j
Else
'Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(I, j)
Next j
End If
Next I
End SubBonjour Anais83, le forum,
Mon problème concerne la partie ou les écarts sont colorés sur la feuille de synthèse car elle compare les lignes une à une , or je souhaiterai que celle ci compare les lignes en fonction de l'ID en colonne "K" mais je ne trouve pas comment faire .... :(
Peut-être ainsi, en remplaçant j par 11 :
If u(I, 11) <> v(I, 11) ThenCordialement,
Bonjour Xorsankukai,
Merci beaucoup pour ton aide, je viens d'essayer mais malheureusement ça ne fonctionne pas , elle colore 3 lignes identiques et plus les écarts :(
'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(I, j)
If u(I, 11) <> v(I, 11) Then
Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
End If
Next j
Bonjour
Une proposition avec PowerQuery (intégré à Excel 2016 et +, en add on sur 2010)
A priori aucune différence en dehors de ID35 et ID40 qui ne figurent chacun que dans une table
Le tableau résultat contient des colonnes supplémentaires indiquant la présence d'écart et alimentant les MFC.
On pourrait les mettre sur un autre onglet...
Bonjour,
@78chris, merci pour ton aide, je ne pense pas à utiliser puisque je ne maitrise pas bien mais c'est une bonne idée ! :)
Avec l'aide d'autres personnes j'ai résolu mon pb je vous communique la macro qui fonctionne si ça peut aider quelqu'un !
Option Explicit
Sub Synthèse()
Dim u, v, Cel As Range
Dim dico1 As Object, dico2 As Object
Dim i As Long, j As Long, lgn As Long, k As Long
Sheets("Synthèse").Select
Range("A2:CF" & Rows.Count).Clear
Application.ScreenUpdating = False
u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)
Set dico1 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(u, 1)
dico1(u(i, 11)) = i
Next i
Set dico2 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v, 1)
dico2(v(i, 11)) = i
Next i
lgn = 1
For i = 1 To UBound(u, 1)
'recopie les lignes de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
If dico2.exists(u(i, 11)) = False Then
Debug.Print "Ajout de 1: " & u(i, 11)
lgn = lgn + 1
For j = 1 To UBound(u, 2)
Sheets("Synthèse").Cells(lgn, j) = u(i, j)
Next j
End If
Next i
For i = 1 To UBound(v, 1)
If v(i, 11) <> "" Then '--- contient un ID
lgn = lgn + 1
If dico1.exists(v(i, 11)) Then
k = dico1(v(i, 11)) '--- n° ligne dans feuil1
Debug.Print u(k, 11) & "<>" & v(i, 11), dico1(v(i, 11)) & "<>" & dico2(v(i, 11))
'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(i, j)
If u(k, j) <> v(i, j) Then
Debug.Print "-- " & u(k, j) & " --> " & v(i, j)
Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
End If
Next j
Else
'Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
Debug.Print "Ajout de 2: " & v(i, 11)
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(i, j)
Next j
End If
End If
Next i
Application.ScreenUpdating = True
End SubBonne journée !
A.