Fusion du contenu de plusieurs cellules en VBA

Version imprimable

07/05/2023, 18h22
Osaka2017

2 pièce(s) jointe(s)

Fusion du contenu de plusieurs cellules en VBA

Bonjour à toutes et tous,

Je fais appel à vos services car je dois réaliser une fusion du contenu de plusieurs cellules et pour être franc, je ne vois pas par où commencer.

L'idée est de fusionner le contenu des cellules de la colonne "Texte" en fonction des numéros et lignes de commande.

Dans l'exemple ci-dessous, la ligne 1 de la commande 22300950 possède 3 lignes alors que la ligne 2 n'en possède qu'une seule.

Il faudrait donc fusionner le contenu des cellules "texte" des 3 lignes 1 de la commande 22300950 pour n'en faire qu'une seule (B C D).

Par contre, pas de fusion pour la ligne 2 car il n'y a qu'une seule ligne (E).

Je vous avoue que le canevas est un peu particulier et loin d'être pratique mais les données sources proviennent directement en brut d'une requête d'un ERP (UBW pour ceux qui connaissent) et il n'est malheureusement pas possible d'effectuer des manipulations de données avant l'exportation du fichier en Excel.

Au lieu de copier directement le résultat dans la feuille "CIBLE", serait-il possible d'utiliser une variable tableau ? Celle-ci pourrait éventuellement être transposée dans la feuille CIBLE.

Je mets le fichier en pièce jointe.

Merci pour aide :)

Vincent

Salut, voici une macro qui fait le travail. Attention, j'ai supposé que la colonne "N° Commande" est triée, si ce n'est pas le cas il faudra prévoir une étape de tri.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub copierTableau()
 
    Dim source As Worksheet
    Dim cible As Worksheet
    Dim ligneSrc As Long
    Dim ligneCib As Long
    Dim dernierLigneSrc As Long
    Dim tableau() As Variant
    Dim col As Long
 
 
    Set source = ThisWorkbook.Sheets("SOURCE")
    Set cible = ThisWorkbook.Sheets("CIBLE")
 
    dernierLigneSrc = source.Cells(Rows.Count, 1).End(xlUp).Row
    ligneCib = 2 'ligne de départ pour copier dans la feuille CIBLE
 
    ' redimensionner le tableau pour qu'il ait le même nombre de lignes et de colonnes que les données de la feuille SOURCE
    ReDim tableau(1 To dernierLigneSrc - 1, 1 To 6)
 
    For ligneSrc = 2 To dernierLigneSrc 'parcours des lignes de la feuille SOURCE à partir de la ligne 2
 
        'si les valeurs des colonnes "N° Commande" et "N° Ligne" sont identiques à la ligne précédente, on regroupe les valeurs de "Texte"
        If source.Cells(ligneSrc, 2).Value = source.Cells(ligneSrc - 1, 2).Value And source.Cells(ligneSrc, 3).Value = source.Cells(ligneSrc - 1, 3).Value Then
            tableau(ligneCib - 2, 4) = tableau(ligneCib - 2, 4) & " " & source.Cells(ligneSrc, 4).Value 'concaténation des valeurs de "Texte"
        Else 'sinon, on recopie la ligne telle quelle dans le tableau
            For col = 1 To 6
                tableau(ligneCib - 1, col) = source.Cells(ligneSrc, col).Value
            Next col
            ligneCib = ligneCib + 1
        End If
 
    Next ligneSrc
 
    ' copier le tableau dans la feuille CIBLE en une seule opération
    cible.Range("A2:F" & ligneCib - 1).Value = tableau
 
End Sub

07/05/2023, 21h49
Osaka2017

Merci pour ton retour rapide Franc.

Ça fonctionne impeccablement bien !

Un tout grand MERCI ;)

1 pièce(s) jointe(s)

Solution avec Power Query

Bonjour,
Une autre approche en utilisant Power Query

Après avoir chargé la table dans Power Query, les étapes sont les suivantes

Ajouter une colonne index à partir de 0 en lui donnant comme "Texte" (Commande Colonne d'index du groupe Général de l'onglet [Ajouter une colonne])
Pivoter la table
Sélectionner la colonne "Index, et cliquer sur la commande Pivoter la colonne (groupe "N'importe qu'elle colonne" de l'onglet "Transformer"
Dans la boîte de dialogue "Pivoter la colonne" choisir comme colonne de valeurs la colonne "texte" et choisir dans les fonctions avancées "Ne pas agréger"
Fusionner les colonnes contenant les textes soit de "0" à "11" (11 c'est le nombre maximum produit par l'indexation)
Sélection des colonnes de "0" à "11"
Cliquer sur la commande Fusionner les colonnes du groupe Colonne Texte de l'onglet [Transformer] en choisissant comme séparateur "Espace" et en lui donnant comme nom "Texte"
Suppression des caractères espacés parasites
Sélection de la colonne "Texte" ainsi fusionnée
faire un clic droit et sélectionner la commande Transformer et cliquer sur Supprimer les espaces
Il ne reste plus qu'à cliquer sur la commande Fermer et charger (Groupe Fermer de l'onglet [Accueil])

Le code ainsi généré donnera ceci
Code:

1 2 3 4 5 6 7 8 9 let Source = Excel.CurrentWorkbook(){[Name="t_Commande"]}[Content], #"Type modifié" = Table.TransformColumnTypes(Source,{{"Année", Int64.Type}, {"N° commande", Int64.Type}, {"N° ligne", Int64.Type}, {"texte", type text}, {"Fournisseur", type any}, {"Qté commandée", Int64.Type}}), #"Index ajouté" = Table.AddIndexColumn(#"Type modifié", "Index", 0, 1, Int64.Type), #"Colonne dynamique" = Table.Pivot(Table.TransformColumnTypes(#"Index ajouté", {{"Index", type text}}, "fr-BE"), List.Distinct(Table.TransformColumnTypes(#"Index ajouté", {{"Index", type text}}, "fr-BE")[Index]), "Index", "texte"), #"Colonnes fusionnées" = Table.CombineColumns(#"Colonne dynamique",{"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Texte"), #"Espaces supprimés" = Table.TransformColumns(#"Colonnes fusionnées",{{"Texte", Text.Trim, type text}}) in #"Espaces supprimés"
Le seul problème c'est que si l'on ajoute ou supprime des lignes à la table "Source", il faudra modifier l'étape de la ligne 6 (#"Colonnes fusionnées")

Pour que ce soit dynamique et ne plus utiliser des constantes, j'ai créé une fonction à laquelle on passe comme arguments, le nom de la table ainsi que le nom de la première colonne à fusionner soit "0"
Cette fonction renverra une liste des colonnes à fusionner

Code de la fonction getColumnLabelsStartingFrom qui renvoie la liste des colonnes à fusionner
Code:

1 2 3 4 5 6 7 8 9 10 let getColumnLabelsStartingFrom = (table as table, columnName as text) => let headerRow = Table.ColumnNames(table), columnIndex = List.PositionOf(headerRow, columnName), columnLabels = List.RemoveFirstN(headerRow, columnIndex) in columnLabels in getColumnLabelsStartingFrom
Il ne reste plus qu'à modifier la partie en rouge de la ligne 6 du code de la requête

Code:

#"Colonnes fusionnées" = Table.CombineColumns(#"Colonne dynamique",{"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Texte"),

par l'appel à la fonction GetColumns(#"Colonne dynamique","0")
soit

Code:

#"Colonnes fusionnées" = Table.CombineColumns(#"Colonne dynamique",GetColumns(#"Colonne dynamique","0"),Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Texte"),

Le code avec le nom des étapes renommé se trouve dans le classeur en téléchargement.
Code:

1 2 3 4 5 6 7 8 9 let Source = Excel.CurrentWorkbook(){[Name="t_Commande"]}[Content], ModifyType = Table.TransformColumnTypes(Source,{{"Année", Int64.Type}, {"N° commande", type text}, {"N° ligne", Int64.Type}, {"texte", type text}, {"Fournisseur", type any}, {"Qté commandée", Int64.Type}}), AddIndex = Table.AddIndexColumn(ModifyType, "Index", 0, 1, Int64.Type), PivotTable = Table.Pivot(Table.TransformColumnTypes(AddIndex, {{"Index", type text}}, "fr-BE"), List.Distinct(Table.TransformColumnTypes(AddIndex, {{"Index", type text}}, "fr-BE")[Index]), "Index", "texte"), MergeColumns = Table.CombineColumns(PivotTable,GetColumns(PivotTable,"0"),Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Text"), Trim_Text = Table.TransformColumns(MergeColumns,{{"Text", Text.Trim, type text}}) in Trim_Text

11/05/2023, 21h11
Osaka2017

Un tout grand merci Philippe !

Je vais explorer ça :)