Excel Compare & XL Comparator

Question

J'ai besoin de votre aide encore une fois. J'ai 2 fichiers avec environ 18,000 lignes chaque. Les deux fichiers ont les même entêtes. Les deux fichiers ont 8 colonnes chaque. Voila ce que j'aimerais avoir si c'est possible: Une macro ou une formule pour comparer les deux fichiers en référence de la première colonne et me donne le résultat dans une autre feuille. Ex Feuille Fabricants en A2 10001 en B2 105 en C2 Chacun en D2 Ex Feuille Fournisseurs en A2 10001 en B2 en C2 Chacun en D2 QUINCAILLERIE Que la formule ou la macro me donne comme résultat: Feuille 3 en A2 10001 en B2 105 en C2 Chacun en D2 QUINCAILLERIE Autrement dit que la formule ou la macro rajoute les manquants. J'ai essayé avec Excel Compare & XL Comparator, les deux me donne le résultat dans une troisième feuille mais double le résultat. I.E. une ligne avec fournisseur et une autre ligne avec fabricant. Donc, je me retrouve avec une feuille de 35,000 lignes au lieu de 18,000 lignes. Je joint mon fichier, et Ex. de Excel Compare ds un Onglet. Merci Beaucoup...

vba-new · Answer

Une solution dans le fichier suivant :Par contre tu essaieras sur tes 18000 lignes, je ne sais pas combien de temps ça prend...

vba-new · Answer

Re,

40 secondes ça fait relativement long !

Essaie avec la macro dans le fichier suivant, ça devrait être bien plus rapide :Le traitement se fait via des variables "tableaux" (le traitement se fait en mémoire plutôt que dans les cellules directement).

Pour optimiser, j'ai mis la colonne "Mots-clés" en 4è position, sur le même modèle que les autres onglets.

Sub consolide()
    Dim derlignFab As Long, derlignFour&, lim1&, lim2&, i&, j&, ind&
    Dim tbl1, tbl2, tbl3()

    'dernière ligne de la feuille "Fabricants"
    derlignFab = Sheets("Fabricants").Range("A" & Rows.Count).End(xlUp).Row
    'dernière ligne de la feuille "Fournisseurs"
    derlignFour = Sheets("Fournisseurs").Range("A" & Rows.Count).End(xlUp).Row
    'on met toutes les données dans 2 variables tableau
    tbl1 = Sheets("Fabricants").Range("A2:H" & derlignFab)
    tbl2 = Sheets("Fournisseurs").Range("A2:H" & derlignFour)
    lim1 = UBound(tbl1): lim2 = UBound(tbl2)

    'on crée un tableau contenant toutes les ressources
    ReDim tbl3(1 To lim1 + lim2, 1 To 2)
    For i = 1 To lim1
        j = j + 1
        tbl3(j, 1) = tbl1(i, 1)
    Next i
    For i = 1 To lim2
        j = j + 1
        tbl3(j, 1) = tbl2(i, 1)
    Next i

    'on crée une liste sans doublons des id ressource
    Set d = CreateObject("Scripting.Dictionary")
    For i = LBound(tbl3) To UBound(tbl3)
        d(tbl3(i, 1)) = ""
    Next i
    With Sheets("Feuil3")
        .Rows("2:" & Rows.Count).ClearContents 'on efface les données
        .[A2].Resize(d.Count, 1) = Application.Transpose(d.keys) 'on met les id en colonne A

        'on récupère les infos
        'l'utilisation de l'objet Dictionary permet un gain de performance dans notre cas
        For ind = 2 To 8
            Set temp = CreateObject("Scripting.Dictionary")
            Set temp2 = CreateObject("Scripting.Dictionary")
            For i = 1 To lim1
                temp(tbl1(i, 1)) = tbl1(i, ind)
            Next i
            For i = 1 To lim2
                temp2(tbl2(i, 1)) = tbl2(i, ind)
            Next i

            Set d = CreateObject("Scripting.Dictionary")
            For i = LBound(tbl3) To UBound(tbl3)
                If Not temp.exists(tbl3(i, 1)) Or temp(tbl3(i, 1)) = "" Then d(tbl3(i, 1)) = temp2(tbl3(i, 1)) Else d(tbl3(i, 1)) = temp(tbl3(i, 1))
            Next i
            Set temp = Nothing
            Set temp2 = Nothing
            .[A2].Offset(, ind - 1).Resize(d.Count, 1) = Application.Transpose(d.items)
            Set d = Nothing
        Next ind
        .[A1].Sort key1:=.[A2], Order1:=xlAscending, Header:=xlGuess 'tri
    End With

End Sub

117fabric-amp-fourn-2013-a-v2.xlsm (142.18 Ko)