Comparer deux colonnes et afficher une 3ème (de dictionnaires VBA)

Bonsoir Forum,

Grâce à ce précieux forum, j'ai pu coder une comparaison de deux colonnes + affichages des colonnes manquantes.

PS : les "abis" et "monDico1bis" sont ma tentative (qui semble fonctionner haha)de refaire la comparaison dans l'autre sens (c'est à dire afficher les col manquantes dans "donnees_Ema" à partir de "donnees_bis" ). Si vous voyez une façon plus propre de le faire, je suis preneuse ! Je vous remercie d'avance.

Maintenant, je souhaiterais afficher une 3ème colonne (donc différente des deux colonnes comparées) en fonction des lignes manquantes. Je m'explique : pour tout compteur manquant dans "donnees_bis", je souhaiterai en plus d'afficher le compte, afficher les points associés à ce compte.

J'ai mis mon essai (en utilisant un 4eme dictionnaire "monDicopoints)" en commentaire car je vois qu'il ne marche pas...Je souhaiterai savoir comment on fait pour sélectionner uniquement les points associées aux compteurs retenues (les compteurs manquants dans). Notez que cet affichage sera fait uniquement dans un sens de la comparaison, car on ne dispose pas de cette info pour "donnees_bis". Les lignes associées resteraient vides.

J'ai également une "petite" question svp : Il me semble que comme mes listes n'ont pas la même taille, le code compare et colle des lignes vides. Cela ne semble pas gêner ici, mais cela dégraderait la qualité du traitement si j'avais des listes plus longues non ? Si c'est le cas, pourrais-je avoir une piste de comment y remédier svp ?

Je vous remercie d'avance pour votre aide.

A votre disposition pour toute information,

Bien à vous,

Ema

22donnees-ema.xlsm (21.61 Ko)

bonjour Ema1234,

pourquoi plusieurs dictionaires ? On peut le faire dans un dictionaire unique et utiliser une matrice comme item. Pour raison de vitesse d'execution, je lis les données des feuilles dans une matrice aA, on peut faire cela aussi directement avec les cellules.

Au bout de cette macro, on peut facilement créer d'autres listes avec des conditions différentes ...

19donnees-ema.xlsm (30.34 Ko)
Sub Ema_1234()

     Dim aA, MonDico1, i, j, aOut, ptr
     Dim It: ReDim It(1 To 5)     'une matrice (nombre d'éléments, par exemple 5, doit rester ce chiffre pendant toute la macro !!!)

     Set MonDico1 = CreateObject("Scripting.Dictionary")

     aA = Sheets("donnees_Ema").Range("A1").CurrentRegion.Resize(, 3).Value     'mettre les données d'Ema dans une matrice
     For i = 2 To UBound(aA)     'boucle sans entête
          For j = 1 To 3: It(j) = aA(i, j): Next     'compte, nom & points dans l'It
          It(4) = "Ema"
          MonDico1(aA(i, 1)) = It     'It as item et compte as key
     Next

     aA = Sheets("donnees_bis").Range("A1").CurrentRegion.Resize(, 2).Value     'mettre les données d'Ema dans une matrice
     For i = 2 To UBound(aA)     'boucle sans entête
          If MonDico1.exists(aA(i, 1)) Then     'ce compte, il existe déjà ?
               It = MonDico1(aA(i, 1))     'alors lire l'item existant
          Else
               ReDim It(1 To UBound(It))     'RAZ d'It
               For j = 1 To 2: It(j) = aA(i, j): Next     'compte et nom dans leur propre position d'It
          End If
          It(5) = "bis"     'comme 4ièem element un "bis"
          MonDico1(aA(i, 1)) = It     'comme nouveau record ou record modifié vers le dictionaire
     Next

     If MonDico1.Count Then     'il y a des records dans le dictionaure
          ReDim aOut(1 To MonDico1.Count, 1 To 3)     'preparer une matrice
          For i = 1 To MonDico1.Count     'boucle les records
               It = MonDico1.items()(i - 1)     'l'item X
               If It(4) = "Ema" And It(5) = "" Then     'connu dans "Ema" et inconnu dans "bis"
                    ptr = ptr + 1     'ajouter ces données à aOut
                    aOut(ptr, 1) = It(1)
                    aOut(ptr, 2) = It(2)
                    aOut(ptr, 3) = It(3)
               End If
          Next
     End If

     With Sheets("Resultat").Range("D2")     'coller les données d'aOut
          .Resize(100, 2).ClearContents
          If ptr > 0 Then .Resize(ptr, UBound(aOut, 2)).Value = aOut Else MsgBox "rien", vbInformation
     End With

     With Sheets("Resultat").Range("K2")     'coller tous les données
          .Resize(100, 2).ClearContents
          If MonDico1.Count Then .Resize(MonDico1.Count, UBound(It)).Value = Application.Index(MonDico1.items, 0, 0)
     End With

End Sub

bonjour à tous,

bonjour Bsalv

comme j'avais également travaillé sur ce sujet, une autre proposition

Sub aargh()
    Set dm = Sheets("donnees_ema")
    Set Db = Sheets("donnees_bis")
    Set r = Sheets("resultat")
    dlm = dm.Cells(Rows.Count, 1).End(xlUp).Row
    dlb = Db.Cells(Rows.Count, 1).End(xlUp).Row
    dba = Db.Cells(1, 1).Resize(dlb, 1)
    dma = dm.Cells(1, 1).Resize(dlm, 3)
    ReDim resa(1 To dlm + dlb, 1 To 2)
    Set dict = CreateObject("scripting.dictionary")
    'dict des comptes présents dans bis
    For i = 1 To dlb
        dict(dba(i, 1)) = i
    Next i
    Set dictb = CreateObject("scripting.dictionary")
    ' dict des comptes présents dans ema
    For i = 1 To dlm
        dictb(dma(i, 1)) = i
    Next i
    'comptes de bis présents dans ema ?
    For i = 1 To dlb
        If Not dictb.exists(dba(i, 1)) Then
            ctr = ctr + 1
            resa(ctr, 1) = dba(i, 1)
        End If
    Next i
    'comptes de ema présents dans bis ?
    For i = 1 To dlm
        If Not dict.exists(dma(i, 1)) Then
            ctr = ctr + 1
            resa(ctr, 1) = dma(i, 1)
            resa(ctr, 2) = dma(i, 3)
        End If
    Next i
    'affichage résultat
    r.Cells.Clear
    r.Cells(2, 1).Resize(ctr, 2) = resa
End Sub
20donnees-ema.xlsm (20.22 Ko)

bonjour,

@H2SO4,

,

je vois que ma vérification était incomplèt vis à vis le résultat souhaité :
            If (It(4) <> "" And It(5) = "") Or (It(4) = "" And It(5) <> "") Then                     'connu dans l'un et inconnu dans l'autre
 

Bonjour à vous deux,

Merci pour vos réponses. Cela me prend un peu de temps, mais j'essaie de bien comprendre vos codes.

Je reviendrais vers vous si j'ai des questions.

En tout cas, cela répond parfaitement à mon besoin. Merci encore.

Très belle journée à tous,

Bien cordialement,

Ema

Rechercher des sujets similaires à "comparer deux colonnes afficher 3eme dictionnaires vba"