Affichage des écarts entre 2 tableaux

psymooon · 9 Août 2014

Bonjour à tous!

Je recherche le moyen de comparer 2 tableaux et d'intégrer les différences à un 3eme tableau à l'aide d'une macro

Voir PJ pour un exemple plus parlant

En gros, dans le 3eme tableau, je voudrais voir s'afficher seulement les références E G et K accompagnées de leurs désignations. Et là je sèche, j'ai du mal à voir la logique:
Comment ne pas afficher la valeur A quand elle va être comparée à B? (Car les 2 références sont prévu...)

Bout de code (loin d'être prêt) :
Sub ecart()

Dim DernLigne1 As Long
Dim DernLigne2 As Long
DernLigne1 = Range("A" & Rows.Count).End(xlUp).Row
DernLigne2 = Range("D" & Rows.Count).End(xlUp).Row

While n <= DernLigne1

Wend

End Sub

N'hésitez pas à me dire si je n'ai pas été assez clair sur ma demande.

Merci d'avance pour vos réponses et bon week-end!

laurent950 · 9 Août 2014

Re : Affichage des écarts entre 2 tableaux

Bonjour,

Sub test()

Dim tab1() As Variant
tab1 = Range(Cells(3, 1), Cells(9, 2))
ReDim Preserve tab1(1 To UBound(tab1, 1), 1 To 3)

tab2 = Range(Cells(3, 4), Cells(9, 6))

For i = 1 To UBound(tab1, 1)
For j = 1 To UBound(tab2, 1)
If tab1(i, 1) = tab2(j, 1) Then
tab1(i, 3) = "x"
End If
Next j
Next i

cpt = 3
For i = 1 To UBound(tab1, 1)
If tab1(i, 3) <> "x" Then
Cells(cpt, 7) = tab1(i, 1)
Cells(cpt, 8) = tab1(i, 2)
cpt = cpt + 1
End If
Next i

End Sub

laurent

job75 · 9 Août 2014

Re : Affichage des écarts entre 2 tableaux

Bonjour psymooon, laurent950,

Voyez le fichier joint et la macro du bouton :

Code:

Private Sub CommandButton1_Click()
Dim t, d As Object, i&, rest(), x$, n&
t = Range("D3:E" & Range("D" & Rows.Count).End(xlUp)(1).Row)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  d(t(i, 1) & Chr(1) & t(i, 2)) = ""
Next
t = Range("A3:B" & Range("A" & Rows.Count).End(xlUp)(1).Row)
ReDim rest(1 To UBound(t), 1 To 2)
For i = 1 To UBound(t)
  x = t(i, 1) & Chr(1) & t(i, 2)
  If Not d.exists(x) Then
    d(x) = "" 'pour éliminer les doublons
    n = n + 1
    rest(n, 1) = t(i, 1)
    rest(n, 2) = t(i, 2)
  End If
Next
If n Then [G3].Resize(n, 2) = rest
End Sub

2 lignes sont considérées comme différentes si au moins une cellule diffère.

Par ailleurs la casse est respectée.

A+

job75 · 10 Août 2014

Re : Affichage des écarts entre 2 tableaux

Bonjour le fil, le forum,

La solution précédente ignore les lignes faisant doublon.

Si l'on veut en tenir compte on peut, comme le fait laurent950, "cocher" les lignes trouvées :

Code:

Option Compare Text 'la casse est ignorée

Private Sub CommandButton1_Click()
Dim t1, t2, ub&, i&, a, b, j&, rest(), n&
t1 = Range("D3:E" & Range("D" & Rows.Count).End(xlUp)(1).Row)
t2 = Range("A3:B" & Range("A" & Rows.Count).End(xlUp)(1).Row)
ub = UBound(t2)
ReDim Preserve t2(1 To ub, 1 To 3)
For i = 1 To UBound(t1)
  a = t1(i, 1): b = t1(i, 2)
  For j = 1 To ub
    If t2(j, 1) = a And t2(j, 2) = b Then _
      If t2(j, 3) = "" Then t2(j, 3) = "x": Exit For
  Next
Next
ReDim rest(1 To ub, 1 To 2)
For i = 1 To ub
  If t2(i, 3) = "" Then
    n = n + 1
    rest(n, 1) = t2(i, 1)
    rest(n, 2) = t2(i, 2)
  End If
Next
If n Then [G3].Resize(n, 2) = rest
End Sub

L'instruction Option Compare Text permet d'ignorer la casse.

Fichier (2).

A+

psymooon · 11 Août 2014

Re : Affichage des écarts entre 2 tableaux

Bonjour,

Merci à vous 2 !

Affichage des écarts entre 2 tableaux

psymooon

XLDnaute Nouveau

Pièces jointes

laurent950

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

psymooon

XLDnaute Nouveau

Discussions similaires