Concaténation en fonction contenu cellule

Version imprimable

10/04/2020, 12h04
nounours1952

Concaténation en fonction contenu cellule
Bonjour à tous,

dans une feuille Excel, j'ai en Col A des références, en Col C des dépendances de A. J'aimerais, en Col D avoir la concaténations de toutes les cellules en C dont la référence en A est identique.

Exemple :
Code:

1 2 3 4 5 Col A Col C Col D AVE 102 AVE_102.eng AVE_102.eng, AVE_102_Cafe.wag, AVE_102_Estd.wag, AVE_102_Ex_P.wag AVE 102 AVE_102_Cafe.wag AVE 102 AVE_102_Estd.wag AVE 102 AVE_102_Ex_P.wag
L'éditeur de macro ne m'étant d'aucune utilité et n'ayant pas trouvé le moindre bout de code qui pourrait m'aider à démarrer, je me retourne vers vous pour me mettre le pied à l'étrier.

Merci d'avance de votre aide.

Cordialement
Pascal
10/04/2020, 13h06
Thautheme

Bonjour Pascal, bonjour le forum,

Deux questions pour ne pas répondre à coté :
La colonne B est-elle vide ?
Les références dans la colonne A sont-elles triées par ordre alphabétique ou pas forcément ?
10/04/2020, 15h47
nounours1952

Bonjour Thautheme,

Citation:

La colonne B est-elle vide ?

Non, elle comporte la dépendance de A, mais non retravaillée et n'est pas utile. Elle a servi de base pour C.

Citation:

Les références dans la colonne A sont-elles triées par ordre alphabétique ou pas forcément ?

Elles sont obligatoirement triées déjà à l'importation des données depuis un fichier .txt.

Cordialement
Pascal

Re,

Peut-être comme ça :

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
39
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim C As String 'déclare la variable C (Concaténation)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable O (Onglet)
Dim TL() As Variant 'déclare la variable TL (Tbaleu des Lignes)
 
Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
O.Columns(4).ClearContents 'efface d'éventuelles anciennes données
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionaire D
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec la donnée en colonne 1 (la référence)
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
    C = "" 'initialise la concaténation C
    For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        'si la donnée en colonne 1 de TV de la boucle 2 est égale à l'élément J du tableau temporaire TMP de la boucle 1,
        'redéfinit la concaténation C
        If TV(I, 1) = TMP(J) Then C = IIf(C = "", TV(I, 3), C & ", " & TV(I, 3))
    Next I 'prochaine ligne de la boucle 2
    ReDim Preserve TL(K) 'redimensionne le tableau des lignes TL (K lignes)
    TL(K) = C 'récupère dans la ligne K de TL la concaténation C
    K = K + 1 'incrémente K
Next J 'prochain élément de la boucle 1
O.Cells(1, "D") = TL(L) 'renvoie le premier élément TL(L) dans la cellule ligne 1 colonne D de l'onglet O
'boucle sur toutes les lignes I du tableau des valeurs TV (en partan de la seconde et jusqu'à l'avant dernière)
For I = 2 To UBound(TV, 1) - 1
    'si la donnée ligne I+1, colonne 1 de TV est différente de la donnée ligne I colonne 1 de TV, renvoie la concaténation C de TL(L+1)
    'dans la cellule ligne I+1 colonne D de l'onglet O, incrémente L
    If TV(I + 1, 1) <> TV(I, 1) Then O.Cells(I + 1, "D") = TL(L + 1): L = L + 1
Next I 'prochaine ligne de la boucle
End Sub

11/04/2020, 07h08
nounours1952

Bonjour à tous,

merci Thautheme, je vais tester ce code dans la journée.

Cordialement
Pascal

Re,

le code provoque une erreur

Code:

1
2
3
4
5
    For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        'si la donnée en colonne 1 de TV de la boucle 2 est égale à l'élément J du tableau temporaire TMP de la boucle 1,
        'redéfinit la concaténation C
        If TV(I, 1) = TMP(J) Then C = IIf(C = "", TV(I, 3), C & ", " & TV(I, 3))
    Next I 'prochaine ligne de la boucle 2

que je suis incapable d'apprécier. Seule adaptation apportée au code : nom de la feuille.

Cordialement
Pascal

11/04/2020, 11h14
ARTURO83

Bonjour à tous,

Si vous avez bien tenu compte de la remarque de Thautheme vous demandant si

Code:

La colonne B est-elle vide ?

vous avez répondu NON, dans ce cas, son code fonctionne bien, dans le cas contraire cela génère une erreur, donc votre colonne B ne doit pas être vide.

Cdlt
11/04/2020, 11h52
nounours1952

Re,

Citation:

Si vous avez bien tenu compte de la remarque de Thautheme vous demandant si
Code : Sélectionner tout - Visualiser dans une fenêtre à part

La colonne B est-elle vide ?

vous avez répondu NON, dans ce cas, son code fonctionne bien, dans le cas contraire cela génère une erreur, donc votre colonne B ne doit pas être vide.

Je suis parti à tort de l'idée que le code tenait compte de mes réponses. Mauvaise interprétation de ma part.

Merci de la piqûre de rappel.

Cordialement
Pascal

Bonjour à tous,

je reviens vers vous avec ma question. Le code de Thautheme provoque toujours la même erreur, que la colonne B soit vide ou non.

En modifiant

Code:

If TV(I, 1) = TMP(J) Then C = IIf(C = "", TV(I, 3), C & ", " & TV(I, 3))

en

Code:

If TV(I, 1) = TMP(J) Then C = IIf(C = "", TV(I, 2), C & ", " & TV(I, 2))

il n'y a plus de blocage et j'obtiens le résultat suivant :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Col A Col B Col D allege_26 allege_26.wag allege_26.wag AVE 102 AVE_102.eng AVE 102 AVE_102_Cafe.wag AVE 102 AVE_102_Estd.wag AVE 102 AVE_102_Ex_P.wag---------------| BB26000 BB26000.eng AVE_102.eng, AVE_102_Cafe.wag, AVE_102_Estd.wag, AVE_102_Ex_P.wag BeeKay_150X BeeKay_SNCF_VINS.wag BB26000.eng Carri_Trasporto_Veicoli_Pack FS_LaadgrsA_FDucato1.wag BeeKay_SNCF_VINS.wag CiternElf CiternElf.wag FS_LaadgrsA_FDucato1.wag D-AAEC_Sffggmrrss_MMP AAE_Sff_136-001_A.wag CiternElf.wag D-AAEC_Sffggmrrss_MMP AAE_Sff_136-002_A.wag D-AAEC_Sffggmrrss_MMP AAE_Sff_136-003_A.wag D-AAEC_Sffggmrrss_MMP AAE_Sff_136-003_B.wag Eaos_SNCF Eaos_SNCF.wag AAE_Sff_136-001_A.wag, AAE_Sff_136-002_A.wag, AAE_Sff_136-003_A.wag, AAE_Sff_136-003_B.wag Esso Esso.wag Eaos_SNCF.wag
Comme on peut le constater, il y a un décalage en Col D après le premier bloc concaténé. La concaténation se retrouve une ligne plus bas que la dernière occurrence. Où se situe le problème (pas possible de suivre l'exécution du code avec F8) ?

Merci d'avance de votre aide.

Cordialement
Pascal

Bonjour,

Effectivement, il y a des petits soucis, mais en attendant que Thautheme veuille bien corriger, je vous propose une autre solution, peut-être plus facile à comprendre.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Concatener()
    Dim i As Long, Lig As Long, DerLig As Long
    Dim Concat As String
    Application.ScreenUpdating = False
    Columns(4).ClearContents
    Lig = 1
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Concat = Cells(Lig, "B")
    For i = 1 To DerLig
        If Cells(i + 1, "A") <> Cells(Lig, "A") Then
            Cells(Lig, "D") = Cells(Lig, "A") & ", " & Concat
            Lig = i + 1
            Concat = Cells(Lig, "B")
        Else
            Concat = Concat & ", " & Cells(i + 1, "B")
        End If
    Next
End Sub

Cdlt

13/04/2020, 08h25
nounours1952

Bonjour à tous,

merci Arturo, je vais tester ce code. Il ressemble d'ailleurs étrangement à celui que je teste depuis plusieurs jours, mais je n'utilise pas la fonction "concat".

Bien que compliqué à comprendre pour un novice, le code de Thautheme est intéressant à plus d'un titre. Il est très bien documenté, mais j'ai bien du mal à comprendre ce qu'il fait dans le détail pour arriver au résultat voulu. Ceci dit, inutile de vouloir se mêler de chirurgie cardiaque lorsque l'on est gynéco ! :D

Cordialement
Pascal

EDIT : ce code fonctionne très bien, merci Arturo. J'espère maintenant arriver à comprendre ou se situait le "nœud" dans ma réflexion. Par contre, la concaténation prend systématiquement la référence de la colonne A en première position. Je vais essayer de corriger.

Encore un grand merci. Je vais pouvoir m'attaquer à la suite.

Re,

après modification
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Concatener() Dim i As Long, Lig As Long, DerLig As Long Dim Concat As String Application.ScreenUpdating = False Columns(4).ClearContents Lig = 1 DerLig = range("A" & Rows.count).End(xlUp).Row Concat = Cells(Lig, "B") For i = 1 To DerLig If Cells(i + 1, "A") <> Cells(Lig, "A") Then Cells(Lig, "D") = Cells(Lig, "B") & ", " & Concat Lig = i + 1 Concat = Cells(Lig, "B") Else Concat = Concat & ", " & Cells(i + 1, "B") End If Next End Sub
la référence à la colonne A disparaît, mais du coup, la première occurrence est concaténée 2 fois :
Code:

1 2 Col A Col B Col D allege_26 allege_26.wag allege_26.wag, allege_26.wag
J'ai un déficit de compréhension du IF Then Else. C'est notamment le IF qui me pose problème.
Dans mon approche,

Citation:

Si 2 <> 1
D = valeur B, même ligne
autrement
concaténer en D, valeurs de B tant que A+1 = A

Pourquoi concaténer lorsqu'il n'y a qu'une seule valeur à reprendre (2<>1) ?

Cordialement
Pascal

Bonjour,

Citation:

Il ressemble d'ailleurs étrangement à celui que je teste depuis plusieurs jours, mais je n'utilise pas la fonction "concat".

"Concat" n'est pas une fonction, mais une variable, on pourrait mettre n'importe quoi, du moment que cela reste compréhensible.

Concernant votre message précédent, il semble que vous ne voulez plus récupérer l'information de la colonne A
Je vous propose les 2 options dans le fichier joint
Pièce jointe 555600

Le code associé pour les 2 options

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
Sub Concatener1() 'Reprend la valeur de la colonne A
    Dim i As Long, Lig As Long, DerLig As Long
    Dim Concat As String
    Application.ScreenUpdating = False
    Columns(4).ClearContents
    Lig = 1
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Concat = Cells(Lig, "B")
    For i = 1 To DerLig
        If Cells(i + 1, "A") <> Cells(Lig, "A") Then
            Cells(Lig, "D") = Cells(Lig, "A") & ", " & Concat
            Lig = i + 1
            Concat = Cells(Lig, "B")
        Else
            Concat = Concat & ", " & Cells(i + 1, "B")
        End If
    Next
End Sub
 
Sub Concatener2() 'Ne reprend pas la valeur de la colonne A
    Dim i As Long, Lig As Long, DerLig As Long
    Dim Concat As String
    Application.ScreenUpdating = False
    Columns(4).ClearContents
    Lig = 1
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    Concat = Cells(Lig, "B")
    For i = 1 To DerLig
        If Cells(i + 1, "A") <> Cells(Lig, "A") Then
            Cells(Lig, "D") = Concat
            Lig = i + 1
            Concat = Cells(Lig, "B")
        Else
            Concat = Concat & ", " & Cells(i + 1, "B")
        End If
    Next
End Sub

Cdlt

13/04/2020, 18h56
nounours1952

Bonsoir,

Citation:

Concernant votre message précédent, il semble que vous ne voulez plus récupérer l'information de la colonne A

Je pense que je me suis mal exprimé, désolé. ;)
La colonne A contient des références, dont dépendent les informations en B.
En clair, A = Renault, Peugeot, Toyota...
et B les modèles de la marque. A n'a donc pas besoin d'être concaténé, mais nettoyé de ses doublons après traitement. Cela, je sais le faire. Le code est prêt.

Merci pour l'aide, Arturo. Le code produit exactement le résultat attendu.

Cordialement
Pascal