XL 2016 Macro VBA, colonnes de 3 feuilles différentes assemblées sans doublon

[Lou61]

Bonjour à tous,

Je viens vers vous aujourd'hui, puisque j'aimerais à l'aide d'une macro pouvoir récupérer 3 colonnes sur 3 feuilles différentes et les "assembler" sur une 4 ème feuille tout cela sans doublon. J'avais auparavant une macro me permettant cela, malheureusement elle utilise les bibliothèques "scripting dictionnary" en lien avec les ActiveX de ce que j'ai compris, et sur le réseau de mon lieu de travail je ne peux les utiliser... J'ai cherché un peu partout, mais je n'ai rien trouvé de concluant. Auriez-vous des solutions, du code existant pouvant répondre à mon problème ? merci beaucoup par avance,

Bonne journée,

Lou

 

[Hasco]

Bonjour,

Utilisez Power-Query inclus dans votre version excel.
Vous ne dites pas si vous voulez les réunir en une seule ou en 3 colonnes (ou plus) ?

cordialement

 

[Lou61]

Petite précision, les colonnes n'ont pas le même emplacement --> Colonne G pour l'une, I pour l'autre et E pour la 3ème.. de plus leurs noms sont différents.

PS : Si vous avez des idées faisant appel aux bibliothèques ( celle que j'utilisais, elle fonctionnait uniquement pour des colonnes présentes sur la même feuille --> union range) je suis preneur, je pourrais peut-être me débrouiller pour faire fonctionner le code ( ce qui n'est pas sûr ),

cdlt

 

[Lou61]

@Hasco , merci pour cette réponse ! je ne l'ai pas précisé oui, mais je n'ai pas accés à Power-Query, choix de l'IT de mon entreprise...

Oui, j'aimerais réunir ces 3 colonnes en une seule et unique 4 ème colonne sans doublon et cela sur une 4ème feuille

cordialement

 

[Hasco]

Re,

Encore plus précis dans vos demandes : et il faut créer cette 4ème feuille !
Le fichier exemple anonymisé et sans données confidentielles, il est où.
C'est l' IT qui l'a sous le bras ?

Cordialement

 

[Lou61]

Re,

Il suffisait de demander !

Dans mon fichier réel, j'ai une clé de comparaison ( concaténation de plusieurs colonnes dans les 3 tableaux des BDD) --> c'est ces 3 clefs que je souhaite fusionner dans une 4ème feuille !

Pour finir les tableaux sont assez grands, plusieurs centaines de lignes ( voire milliers) chacun. Je ne souhaite pas que la liste sans doublon soit un tableau, simplement une liste suffirait.... , merci de prendre du temps pour m'aider

cordialement,

Lou

 

[Hasco]

Re
Et la colonne des clefs est toujours la dernière des tableaux ? Sinon partagent-elles un nom commun (dans votre exemple ce n'est pas le cas). En d'autre termes : comment reconnaître la colonne des clefs ?

cordialement

 

[Lou61]

Non, elles n'ont pas forcément le même nom, ni le même emplacement, il faudrait donc que je suis puisse indiquer directement dans le code l'intitulé des 3 colonnes, ou la lettre de la colonne correspondant à leur emplacement, c'est pour cela que j'ai réalisé l'exemple ainsi. Oui, oui, ça rend la chose bien plus compliquée à automatiser..

cordialement,

 

[Hasco]

Re,

(fait avant d'avoir lu votre dernière réponse)

Si ce que vous disiez et que j'avais zappé est toujours vrai :

Petite précision, les colonnes n'ont pas le même emplacement --> Colonne G pour l'une, I pour l'autre et E pour la 3ème.. de plus leurs noms sont différents.

Je modifierai demain la macro ci-dessous pour quelle prenne les colonnes G (BDD1),I (BDD2),E (BDD3).

Voici une macro qui :
1 - cherche la colonne correspondant au masque "Clé_*" dans l'entête des tableaux
2 - copie les données, les unes à la suite des autres
3 - insère une fonction de comptage de doublons en colonne B de la feuille de fusion (=NB.SI)
4 - Tri le tableau de la feuille de fusion sur la colonne B en ordre descendant pour que les 1 (items uniqus) se retouvent en bas.
5 - Trouve l'index du premier 1 dans la colonne B
6 - supprime les lignes de 2 à index du premier 1 (ligne de doublons)

Sub Colonner()
    Dim ws As Worksheet, wsDest As Worksheet
    Dim Valeurs As Variant
    Dim ligne As Long
    Dim idx As Variant
    With ThisWorkbook
        'Destination des données
        ' Nettoyer
        Set wsDest = .Sheets("Fusion_3_BDD")
        ligne = wsDest.Cells(Rows.Count, 1).End(xlUp).Row
        If ligne > 2 Then wsDest.Range("A2:A" & ligne).ClearContents
        '
        '
        ' Import des données
        For Each ws In .Worksheets(Array("BDD1", "BDD2", "BDD3"))
            With ws.ListObjects(1)
                idx = Application.Match("Clé_de_*", .HeaderRowRange, 0)
                If Not IsError(idx) Then Valeurs = .ListColumns(idx).DataBodyRange
                If IsArray(Valeurs) Then
                   wsDest.Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(Valeurs)).Value = Valeurs
                End If
            End With
        Next ws
    End With
 
    With wsDest
        '
        ' Dernière ligne de donnée de la colonne A
        ligne = .Cells(Rows.Count, 1).End(xlUp).Row
        '
        ' Entêter B1
        .Range("B1") = "nbr"
        '
        ' Mettre formule de comptage en colonne B
        With .Range("B2:B" & ligne)
            .Formula = "=COUNTIF($A$2:$A$" & ligne & ",$A2)"
            .Value = .Value
        End With
        '
        'Trier sur colonne B en ordre descendant
        .Range("A1").CurrentRegion.Sort .Range("B2"), xlDescending
        '
        ' Sur de très long tableaux
        ' il peut y avoir un temps de latence pour le calcul de la feuille
        ' Attendre l'application
        Do
            DoEvents
        Loop Until Application.CalculationState = xlDone
        '
        ' Chercher la première valeurs = 1 dans colonne b
        idx = Application.Match(1, .Columns(2), 0)
        '
        ' Si trouvé supprimer toutes les autres lignes
        If Not IsError(idx) Then .Range("A2:B" & idx).Rows.Delete xlShiftUp
        '
        ' Supprimer les données de colonne B
        .Range("B1:B" & ligne).ClearContents
    End With
End Sub

Cordialement

 

[Lou61]

Merci beaucoup ! j'essaierais tout ça demain matin au plus tard et je vous donnerais un feedback super !

cordialement,

 

[Hasco]

Re,

C'est fait, j'ai modifié dans la macro ci-dessous.
Je n'ai pas mis les tableaux de noms de feuilles et colonnes en variables car pour 3 items ce n'est pas ça qui va ralentir la boucle.

Adapter les noms de feuilles et lettres de colonnes.

Sub Colonner()
    Dim ws As Worksheet, wsDest As Worksheet
    Dim Valeurs As Variant, Colonnes As Variant
    Dim ligne As Long
    Dim idx As Variant
    Dim i As Integer
    Dim nomCol As String
    With ThisWorkbook
        'Destination des données
        ' Nettoyer
        Set wsDest = .Sheets("Fusion_3_BDD")
        ligne = wsDest.Cells(Rows.Count, 1).End(xlUp).Row
        If ligne > 2 Then wsDest.Range("A2:A" & ligne).ClearContents
        '
        '
        ' Import des données
        For i = 0 To 2
            Set ws = .Sheets(Array("BDD1", "BDD2", "BDD3")(i))
            With ws.Range(Array("B1", "C1", "D1")(i)).ListObject
                nomCol = ws.Range(Array("B1", "C1", "D1")(i))
                idx = Application.Match(nomCol, .HeaderRowRange, 0)
                If Not IsError(idx) Then Valeurs = .ListColumns(idx).DataBodyRange
                If IsArray(Valeurs) Then
                   wsDest.Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(Valeurs)).Value = Valeurs
                End If
            End With
        Next
    End With
    
    With wsDest
        '
        ' Dernière ligne de donnée de la colonne A
        ligne = .Cells(Rows.Count, 1).End(xlUp).Row
        '
        ' Entêter B1
        .Range("B1") = "nbr"
        '
        ' Mettre formule de comptage en colonne B
        With .Range("B2:B" & ligne)
            .Formula = "=COUNTIF($A$2:$A$" & ligne & ",$A2)"
            .Value = .Value
        End With
        '
        'Trier sur colonne B en ordre descendant
        .Range("A1").CurrentRegion.Sort .Range("B2"), xlDescending
        '
        ' Sur de très long tableau
        ' il peut y avoir un temps de latence pour le calcul de la feuille
        ' Attendre l'application
        Do
            DoEvents
        Loop Until Application.CalculationState = xlDone
        '
        ' Chercher la première valeurs = 1 dans colonne b
        idx = Application.Match(1, .Columns(2), 0)
        '
        ' Si trouvé supprimer toutes les autres lignes
        If Not IsError(idx) Then .Range("A2:B" & idx).Rows.Delete xlShiftUp
        '
        ' Supprimer les données de colonne B
        .Range("B1:B" & ligne).ClearContents
    End With
End Sub

Cordialement

 

[Lou61]

Super merci ! Je testerais tout ça si je veux appliquer des filtres à mes 3 BDD, étant donné le système de boucle, j'imagine que je dois les appliquer avant le début de ce code non ? ( en sachant que chaque BDD aura des filtres différents étant donné qu'ils ne sont pas identiques au niveau du format et du contenu) ?

cordialement,

Lou

 

[Hasco]

Re,

Euh, à moins d'avoir encore zappé quelque chose, la macro se contente de répondre à la demande du post#1.
et il n'était pas question de filtre dans cette demande...
Soyez précis dès le départ, sinon on va pas s'en sortir.

 

[Lou61]

Désolé pour ça... je ne voulais juste pas rajouter de la complexité à tout ça et je pensais que cela serait ajoutable facilement ..

cordialement

 

[Hasco]

Ne soyez pas désolé, soyez précis.
La macro ne prévoit pas de parcourir une plage filtrée.
On en est déjà à 14 messages... et on ne sait toujours pas où on va.