VBA - Comparaison

Bonjour,

J'ai une macro qui permet de comparer deux tableaux et de donner la différece entre eux.

Sub test()
Dim Colonne1 As Range
Dim Colonne2 As Range
 Dim suite As Range
 Dim trouve As Range

   'Compare la colonne A de la feuille 1 et colonne 1 de la feuille 2
  Set Colonne1 = Sheets("Feuil1").Range(("A2"), Sheets("Feuil1").Range("AO2").End(xlDown))
  Set Colonne2 = Sheets("Feuil2").Range(("A2"), Sheets("Feuil2").Range("A2").End(xlDown))

    'Retranscrit les données différente de la feuille
  For Each Cellule In Colonne1
  Set suite = Sheets("Result").[A65536].End(xlUp).Offset(1, 0)
  Set trouve = Colonne2.find(Cellule.Value, LookIn:=xlValues, lookat:=xlWhole)
  If trouve Is Nothing Then
      suite.Value = Cellule.Value
      suite.Offset(0, 1).Formula = "=VLOOKUP(" & suite.Address & ",'" & Colonne1.Parent.Name & "'!" & Colonne1.Resize(, 15).Address & ",1,FALSE)"
  End If
  Next
End Sub

J'ai pas trouvé par quoi remplacer le

  If trouve Is Nothing Then

pour dire, qu'au contraire, si il trouve la même cellule il retranscrit.... Le = ne fonctionne pas.

Merci d'avance pour vos lumières.

Nuno

Bonjour,

Peut-être :

  If not trouve Is Nothing Then

A+

Bonjour,

Merci Galopin1, ça fonctionne, par contre j'ai un nouveau problème,les valeurs remonte bien mais j'ai un bug de correspondance.

Je voudrais comparer deux tables sur deux feuilles différente et pour chaque valeur trouver sur la première table me remonter tous les champs associer.

Voici mon fichier, ça sera plus parlant je pense...

Bonjour,

tu demandes (sauf erreur) de ramener par ex:

A12B3 / 1 / SQUARE dans le tableau de droite, hors dans OLD A12B3 / 1 comporte XA34KF3 donc pas SQUARE...

P.

Euh oui , c'est exact, k'ai modifier le fichier exemple avec le résultat attendu ^^

Bonjour,

j'ai fais d'une autre manière , regarde si ça te convient ...

P.

Bonsoir à tous,

Pour le fun

Option Explicit
Sub test()
Dim a, w(), e, i As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.comparemode = 1
    With Sheets("Matrice")
        a = .Range("a1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            dico.Item(a(i, 1)) = Empty
        Next
        With Sheets("Old")
            a = .Range("a1").CurrentRegion.Value
            For i = 2 To UBound(a, 1)
                If dico.exists(a(i, 1)) Then
                    If IsEmpty(dico(a(i, 1))) Then
                        ReDim w(1 To 3, 1 To 1)
                    Else
                        w = dico.Item(a(i, 1))
                        ReDim Preserve w(1 To 3, 1 To UBound(w, 2) + 1)
                    End If
                    w(1, UBound(w, 2)) = a(i, 1)
                    w(2, UBound(w, 2)) = a(i, 2)
                    w(3, UBound(w, 2)) = a(i, 4)
                    dico.Item(a(i, 1)) = w
                End If
            Next
            For Each e In dico.keys
                If IsEmpty(dico.Item(e)) Then dico.Remove e
            Next
        End With
        With .Range("d1").CurrentRegion
            With .Offset(1)
                .Clear
                If dico.Count > 0 Then
                    For i = 0 To dico.Count - 1
                        .Offset(n).Resize(UBound(dico.items()(i), 2)) = _
                                    Application.Transpose(dico.items()(i))
                        n = n + UBound(dico.items()(i), 2)
                    Next
                Else
                    MsgBox "aucune donnée à restituer"
                End If
            End With
        End With
    End With
    Set dico = Nothing
End Sub

klin89

Bonjour patrick1957 & Klin89 ,

Merci beaucoup pour votre aide c'est parfait

Je viens de comprendre la logique entre For et With, merci beaucoup pour vos lumières

A bientôt

Juste dernière question,

J'ai rajouter une colonne dans la matrice à gauche de la valeur chercher. Vous savez si il est possible de la lier aux résultats ?

Je vous joins l'exemple.

Bonjour,

Le code de Klin89 est comme toujours excellent , mais comme j'ai toujours du mal avec la compréhension et qu' il y a peu de données, je continue sur mon code sans toucher à celui de Klin89.

L'avantage de son code est qu'il fonctionnera beaucoup plus vite s'il y a des milliers de lignes

Sub test()
Dim Old As Range
Dim Matrice As Range
Dim trouve As Range
Dim suite As Range
Dim Ws1, Ws2 As Worksheet
Set Ws1 = Sheets("Old"): Set Ws2 = Sheets("Matrice")
'Compare la colonne A de la feuille Matrice et colonne G de la feuille Matrice
Set Old = Ws1.Range(("A2"), Ws1.Range("A2").End(xlDown))
Set Matrice = Ws2.Range(("B2"), Ws2.Range("B2").End(xlDown))
'Retranscrit les données différente de la feuille
For Each cel In Matrice ' boucle dans la feuille Matrice
   With Old ' zone de recherche en onglet OLD
      Set c = .Find(cel, LookIn:=xlValues, lookat:=xlWhole)
      If Not c Is Nothing Then
         Set suite = Ws2.[E65536].End(xlUp).Offset(1, 0)
         FirstAddress = c.Address
         Do ' boucle tant que c est c est <> ""
            suite.Value = c.Value: suite.Offset(, 2) = c.Offset(, 1)
            suite.Offset(0, 1) = cel.Offset(0, -1)
            suite.Offset(0, 3) = c.Offset(0, 3)
            Set suite = Sheets("Matrice").[E65536].End(xlUp).Offset(1, 0)
            Set c = .FindNext(c)
         Loop While Not c Is Nothing And c.Address <> FirstAddress
      End If
   End With
Next   ' cel
End Sub

Bonjour patrick1957,

Encore merci pour ton aide, oui c'es vrai que j'ai eu un peu de mal à comprendre aussi le code de Klin89 malgrès qu'il soit rapide à exécuté. Je continue à chercher le fondement de la logique pour pouvoir tout adapter.

Merci beaucoup pour ton coup de main

Re nunos31,

Salut patrick1957

Comme ceci :

Option Explicit
Sub test()
Dim a, w(), x(), e, i As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.comparemode = 1
    With Sheets("Matrice")
        a = .Range("a1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            dico.Item(a(i, 2)) = VBA.Array(a(i, 1), Empty)
        Next
        With Sheets("Old")
            a = .Range("a1").CurrentRegion.Value
            For i = 2 To UBound(a, 1)
                If dico.exists(a(i, 1)) Then
                    w = dico.Item(a(i, 1))
                    If IsEmpty(w(1)) Then
                        ReDim x(1 To 4, 1 To 1)
                    Else
                        x = w(1)
                        ReDim Preserve x(1 To 4, 1 To UBound(x, 2) + 1)
                    End If
                    x(1, UBound(x, 2)) = a(i, 1)
                    x(2, UBound(x, 2)) = w(0)
                    x(3, UBound(x, 2)) = a(i, 2)
                    x(4, UBound(x, 2)) = a(i, 4)
                    w(1) = x
                    dico.Item(a(i, 1)) = w
                End If
            Next
            For Each e In dico.keys
                If IsEmpty(dico.Item(e)(1)) Then dico.Remove e
            Next
        End With
        With .Range("e1").CurrentRegion
            With .Offset(1)
                .Clear
                If dico.Count > 0 Then
                    For i = 0 To dico.Count - 1
                        .Offset(n).Resize(UBound(dico.items()(i)(1), 2)) = _
                             Application.Transpose(dico.items()(i)(1))
                        n = n + UBound(dico.items()(i)(1), 2)
                    Next
                Else
                    MsgBox "aucune donnée à restituer"
                End If
            End With
        End With
    End With
    Set dico = Nothing
End Sub

klin89

Re nunos31,

Je ne comprends pas 8)

feuille "Matrice", on a ceci :

feuille "Old", on a cela :

et on doit restituer :

C'est quoi la logique

klin89

Bonjour,

salut Klin

dans le fichier il a indique ceci: "Pour chaque valeur trouver dans la colonne A de Matrice, reporter toutes les valeurs correspondante de la colonne A de Old en Matrice D"

donc pour chaque "serial" de Matrice colonne B, il faut ramener tout les "ref" de la colonne A mais aussi tout les PART de OLD correspondant à chaque "serial" de matrice...

(si j'ai compris)

enfin, si on devait suivre la logique des demandeurs, parfois en s’ennuierait

Bonjour patrick1957,

Oui c'est exactement ça, la logique c'est pour un sérial donné on peut avoir une autre référence, bien que celà peut rester rare dans la gestion de logistique celà peut être utiliser dans des buts de tacking plus poussé dans mon cas d'ou une double référence sur un même produits