[VBA] (PowerQuery?) - Alignement de tables (2)

Bonjour,

Cette discussion fait suite à celle-ci : https://forum.excel-pratique.com/viewtopic.php?f=2&t=139613

J'ai préparé un document dans lequel j'aimerais croiser deux tables de quelques lignes actuellement.

L'idée ici serait de comparer la feuille "BDC" (Colonne "NOM_VALIDE_TAXREF") avec la feuille "TAXREF" (Colonne "NOM_COMPLET").

Si la valeur est présente dans "NOM_COMPLET" et "NOM_VALIDE_TAXREF", alors copier toutes les informations contenues entre la colonne 2 et la colonne 67 (feuille TAXREF) et les coller dans la feuille "BDC", à la ligne correspondante, après la dernière colonne (col 25).

Si la valeur est présente dans "NOM_COMPLET" mais absente dans "NOM_VALIDE_TAXREF", alors copier toutes les informations contenues entre la colonne 2 et la colonne 67 (feuille TAXREF) et les coller dans la feuille "BDC", à la dernière ligne, après la dernière colonne (col 25). (ou alors ajouter une ligne comme je l'ai fait dans le tableau d'exemples).

Est-ce que ce genre de traitements peut être réalisé à partir de tableaux ou de dictionnaires ? Cela permettra d'augmenter la vitesse d'exécution de la macro, dans l'optique de l'utiliser sur des listes plus grosses.

Je vous remercie de votre attention et espère avoir été suffisamment clair dans mes explications

A plus tard !

Bonjour,

J'ai mis à jour mon document de travail, de manière à ce qu'il soit plus simple à utiliser.

En vert, il s'agit de la table TAXREF ; en orange la base BDC.

En rouge les colonnes qui sont comparées.

J'essaie d'aligner les données, comme présenté dans les résultats.

J'aimerais passer par des tableaux pour accélérer la procédure ;

voici un de mes essais :

Sub test2()
Dim i&, lrst&, lcst&, lrtx&, nc As Byte, nv As Byte, a&, tablo(), Dict As Object, tablo1, tablo3, m%

    Set Dict = CreateObject("scripting.dictionary")

    With Sheets("TAXREF")
        lrtx = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        'nc = .Range("1:1").Find("NOM_COMPLET", LookIn:=xlValues, Lookat:=xlWhole).Column
        tablo1 = .Range(.Cells(2, 2), .Cells(lrtx, 67))
        For i = LBound(tablo1) To UBound(tablo1)
            For m = 1 To 66
                Dict(tablo1(i, m)) = tablo1(i, m)
            Next m
        Next i
    End With
'    Sheets("Test").Cells(2, 1).Resize(lrtx - 1) = tablo1

    With Sheets("BDC")
        lrst = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        lcst = .UsedRange.Columns.Count
        nv = .Range("1:1").Find("NOM_VALIDE_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column
        tablo3 = .Range(.Cells(2, 2), .Cells(lrst, 24))
    End With

    ReDim tablo(1 To lrst - 1, 1 To 91)
    For a = 1 To UBound(tablo3)
        If Dict.exists(tablo3(a, 10)) Then
            For t = 1 To 23
                tablo(a, t) = Dict(tablo3(a, t))
            Next t
            'For t = 24 To 91
            '    tablo(a, t) = Dict(tablo3(a, t))
            'Next t
        'Else
        '    tablo(a, 1) = ""
        End If
    Next a
    Sheets("Test").Cells(2, 1).Resize(lrst - 1) = tablo
End Sub

Pour le moment je ne vois pas comment faire...

A plus tard !

Bonjour Le Drosophile,

Pour aligner les enregistrements de la feuille "TAXREF" aux enregistrements de la feuille "BDC", je me suis appuyé sur la colonne B (de "BDC") et colonne F de "TAXREF" pour identifier les doublons.

A tester sur le fichier du post #1#

Résultat sur une feuille nouvellement créée.

Pour bien visualiser l'alignement, masque toutes les colonnes entre la colonne B et la colonne AC.

Option Explicit
Sub test()
    Dim a, e, i As Long, ii As Long, w, t As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    For Each e In Array(Array("BDC", 2, 1, 24, 0), Array("TAXREF", 6, 2, 68, 23))
        a = Sheets(e(0)).Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If Not dico.exists(a(i, e(1))) Then
                ReDim w(1 To 93, 1 To 1)
            Else
                w = dico(a(i, e(1)))
            End If
            t = w(UBound(w, 1) - IIf(e(0) = "BDC", 1, 0), 1) + 1
            If UBound(w, 2) < t Then ReDim Preserve w(1 To UBound(w, 1), 1 To t)
            For ii = e(2) To e(3)
                w(ii + e(4), t) = a(i, ii)
            Next
            w(UBound(w, 1) - IIf(e(0) = "BDC", 1, 0), 1) = t
            dico(a(i, e(1))) = w
        Next
    Next
    Application.ScreenUpdating = False
    With Sheets.Add
        n = 2
        For Each e In dico
            With .Rows(n).Resize(UBound(dico(e), 2), UBound(dico(e), 1) - 2)
                .Value = Application.Transpose(dico(e))
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
            End With
            n = n + UBound(dico(e), 2)
        Next
        With .UsedRange
            .VerticalAlignment = xlCenter
            .Font.Name = "Calibri"
            .Font.Size = 10
            '.Columns.AutoFit
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir,

Encore une merveille de code sur ce forum

Votre proposition, testée sur le document initial puis sur l'alignement de deux bases de données (141 000 lignes <> 98 000 lignes) prend 3minutes à s'exécuter, pour obtenir l'a base ultime !

A priori, je ne constate pas d'erreur, mais vu la taille, il va me falloir du temps à parcourir un peu tout pour m'en assurer !

Par contre, je ne comprend pas tout dans le code que vous proposez, même en pas à pas je me questionne encore. Il faudra de toute manière que je lise des tutoriels sur les fonctions que vous utilisez, car je ne les utilise pas (exemple : IIf ; ce qu'on désigne avec "Array(Array("BDC", 2, 1, 24, 0)") .

Si vous avez un petit moment pour indiquer ce que les lignes les plus importantes de votre macro font, je suis preneur ! Les bases en VBA que j'ai acquis grâce à ce forum sont un peu chamboulées ici

Encore merci pour votre aide !

A plus tard