Macro fusion de plusieurs colonnes sans doublon avec filtre

Question

Je viens vers vous aujourd'hui étant mon problème que je n'arrive pas à résoudre seul avec mes compétences actuelles en VBA : - J'aimerais pouvoir fusionner 3 colonnes se trouvant sur 3 feuilles différentes, avec comme lieu d'arrivée une quatrième feuille ou la macro copierait la totalité de la liste triée sans doublon . - A savoir qu'elles n'ont pas le même format, c'est à dire, pas les mêmes noms de colonne, ni le même emplacement ( colonne E pour l'une, G pour l'autre, etc..), de plus j'aimerais pouvoir appliquer des filtres personnalisés sur chaque BDD avant leur fusion, filtres ici encore une fois différents pour chaque BDD étant donné que ce sont 3 systèmes d'information n'étant pas censé communiquer entre eux. Si vous avez peut-être des suggestions, programmes existants je suis preneur, le graal serait de pouvoir avoir un programme qui puisse être assez facilement modifiable si je dois décaler une colonne etc.. , je vous transmets ci-joint un fichier exemple, avec 3 BDD et une feuille "d'arrivée" merci d'avance pour votre aide :) cordialement...

BsAlv · Answer

3 manières de copier et coller, puis sorter et effacer les doublons Sub test() With Sheets("fusion_3_BDD") Sheets("BDD1").ListObjects(1).ListColumns(2).DataBodyRange.Copy '&lt;&lt;&lt; le numéro de la listcolonne .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues Sheets("BDD2").ListObjects(1).ListColumns("Clé_de_correspondance2").DataBodyRange.Copy '&lt;&lt;&lt; le nom de la listcolonne .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues Set c = Sheets("BDD3").ListObjects(1).ListColumns("Clé_de_correspondance3").DataBodyRange .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(c.Rows.Count).Value = c.Value 'les valeurs .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp)).Sort .Range("A1"), Header:=xlYes 'sorter toute la colonne .Range(.Range("A1"), .Range("A" & Rows.Count)).RemoveDuplicates Columns:=1, Header:=xlYes 'no doublons dans cette plage End With End Sub...

BsAlv · Answer

Si vous avez des tableaux filtrés a ce moment, la méthode 3 ne fonctionnera pas, parce qu'elle copie et colle tout, aussi les lignes cachées. Concernant la vitesse et des milliers de lignes, il n'y a pas de problèmes tant que vous ne dépassez pas les limites de la feuille (nombre de lignes &gt;1.048.000), vitesse = quasi instantément...

BsAlv · Answer

Concernant le nom de la colonne, y-a-t-il quelque chose unique en commun, par exemple "Clé_de_correspondance" ou "correspondance" ...

BsAlv · Answer

No, je n'ai pas de piste, sauf cela a quelque chose à faire avec ce "end(xlup)", mais c'est à résoudre avec "Application.goto" Dans cet exemple, j'ai ajouté un tableau qui guide la macro avec nom de tableaux et colonnes.Donc, on ne doit plus changer la macro quand quelque chose autre change. Et un exemple de chercher la colonne avec le mot "clé" dedans Sub test() t = Timer With Sheets("fusion_3_BDD") a = .ListObjects("TBL_Macro").DataBodyRange.Value 'EXEMPLE POUR CHERCHER LA LISTCOLUMN QUI CONTIENT LE MOT "CLE" entetes = Application.Transpose(Application.Transpose(Range(a(1, 1)).ListObject.HeaderRowRange.Value)) 'les entetes du listobject qui correspond avec la premiere ligne du tableau TBL_Macro fl = Filter(entetes, "clé", 1, 1) 'filtrer ces entetes avec "cle" dedans colonne = Application.Match(fl(0), entetes, 0) 'la premiere colonne qui contient "clé" MsgBox "c'est colonne " & colonne For i = 1 To UBound(a) Range(a(i, 1)).ListObject.ListColumns(a(i, 2)).DataBodyRange.Copy '&lt;&lt;&lt; le nom du tableau et ou le nom de la colonne ou le numéro de la colonne .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues Next Application.Goto .Range("A1") 'positionner sur cette cellule .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp)).Sort .Range("A1"), Header:=xlYes 'sorter toute la colonne .Range(.Range("A1"), .Range("A" & Rows.Count)).RemoveDuplicates Columns:=1, Header:=xlYes 'no doublons dans cette plage End With MsgBox "prêt en " & Format(Timer - t, "0.0\s") 'temps si l'autre msgbox n'etait pas là End Sub...

BsAlv · Answer

Non, il faut regarder au tableau "TBL_Macro" (commence à E1 de la feuille fusion_3_BDD) , la macro lit son contenu dans la matrice a . Le nombre de lignes de ce tableau est ubound(a) et le "for ... next" fait donc ubound(a) boucles. la première colonne de TBL_Macro contient tous les noms des tableaux que vous voulez utiliser et la 2ième colonne contient le nom de la colonne de ce tableau ou le numéro de la colonne de ce tableau. exemple 1 : première ligne du TBL_Macro : i = 1 &gt;&gt;&gt; a(1,1) = Tableau 1 et a(1,2) = Clé_de_correspondance1 , donc ... Range(a(i, 1)) .ListObject . ListColumns(a(i, 2)) . DataBodyRange .Copy &gt;&gt;&gt;&gt; Range(a(i,1)) = la plage des données de ce tableau sans les entêtes, donc Tableau1 Le ".listobject" fait de cette plage un tableau Le ".listcolumns(....)" prend de ce tableau la colonne définit entre les parathèses (numérique ou texte, ici texte), dans ce cas " Clé_de_correspondance1" Le .databodyrange prend la plage des données de cette listcolumn et ... Copy tout cela en dessous la colonne A de Fusion_3_BDD. exemple 2 = 2ième ligne de TBL_Macro : i = 2 &gt;&gt;&gt; a(2,1) = Tableau 13 et a(2,2) = 3, donc ... la plage a copier vient du tableau "Tableau 13" et comme a(2,2)=3 est numérique, donc la 3ième colonne. etc Donc le nombre de lignes dans tableau "TBL_Macro" est le nombre de tableaux que vous voulez fusionner. Bien remarqué : Le filtrage de ces 3 tableaux (manuellement ou VBA) doit se faire avant le lancement de cette macro...

BsAlv · Answer

Si ce tableau reste dans le même fichier. (Pour le moment, je n'utilise pas la construction "With ... End With") 2 possibilités, a = Sheets("Autre Feuille").ListObjects("TBL_Macro").DataBodyRange.Value a = Range("TBL_Macro").ListObject.DataBodyRange.Value remarque : 2ième ligne, c'est Listobject (sans dernier "s") et on ne doit pas préciser la feuille...

BsAlv · Answer

La partie après "Application.goto ... " jusqu'à "End with" est modifié un petit peu. La macro contrôle pour chaque cellule la partie après le dernier "_", si cela est numerique, elle le remplace par son valeur. Sub test() t = Timer With Sheets("fusion_3_BDD") a = .ListObjects("TBL_Macro").DataBodyRange.Value 'EXEMPLE POUR CHERCHER LA LISTCOLUMN QUI CONTIENT LE MOT "CLE" entetes = Application.Transpose(Application.Transpose(Range(a(1, 1)).ListObject.HeaderRowRange.Value)) 'les entetes du listobject qui correspond avec la premiere ligne du tableau TBL_Macro fl = Filter(entetes, "clé", 1, 1) 'filtrer ces entetes avec "cle" dedans colonne = Application.Match(fl(0), entetes, 0) 'la premiere colonne qui contient "clé" MsgBox "c'est colonne " & colonne For i = 1 To UBound(a) Range(a(i, 1)).ListObject.ListColumns(a(i, 2)).DataBodyRange.Copy '&lt;&lt;&lt; le nom du tableau et ou le nom de la colonne ou le numéro de la colonne .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues Next Application.Goto .Range("A1") 'positionner sur cette cellule With .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp)) 'les données a = .Value 'lire plage &gt;&gt;&gt; matrice For i = 2 To UBound(a) 'boucle mais ne pas l'entête sp = Split(a(i, 1), "_") 'séparer sur le "_" If IsNumeric(sp(UBound(sp))) Then 'la dernière partie est numerique sp(UBound(sp)) = --sp(UBound(sp)) 'remplacer ce string par son valeur (=eliminer les "leading" zéros) a(i, 1) = Join(sp, "_") 'adapter la matrice End If Next .Value = a 'écrire matrice &gt;&gt;&gt; plage .Sort .Range("A1"), Header:=xlYes 'sorter toute la colonne .RemoveDuplicates Columns:=1, Header:=xlYes 'no doublons dans cette plage End With End With MsgBox "prêt en " & Format(Timer - t, "0.0\s") 'temps si l'autre msgbox n'etait pas là End Sub...