Macro - Concaténer colonne

Version imprimable

02/01/2015, 19h38
tam938

Macro - Concaténer colonne

Bonjour,

Je cherche une macro qui me permettra de concaténer les lignes d'une colonnes.
J'ai essayé avec la formule =Concatener et = B2&B3 ... et j'obtiens ce que je veux.
Or, j'ai beaucoup de données à traiter et je souhaite le faire avec une Macro VBA EXCEL.

Je vous explique ce que je veux:
Dans le fichier en pj, je veux concaténer les cellules de la colonne B. Mais pas toutes dans la même cellule.
En effet, je veux le faire en fonction de la donnée de la colonne "A".
~~Dans le fichier en pj,~~ j'ai mis dans la colonne "C" le résultat que je souhaite obtenir.

Merci d'avance pour votre aide.
J'aimerai bien que vous m'expliquiez votre code ---> Pour ma culture VBA :)

Tam938
02/01/2015, 20h49
Philippe Tulliez

Bonjour,

Citation:

Je cherche une macro qui me permettra de concaténer les lignes d'une colonnes.
J'ai essayé avec la formule =Concatener et = A1&B1 ... et j'obtiens ce que je veux.

Il y a une contradiction dans cette demande si tu concatènes A1 & B1 ce sont les colonnes d'une ligne et pas l'inverse.
02/01/2015, 20h58
tam938

Merci Philippe, je viens de corriger.
02/01/2015, 21h45
Thautheme

Bonsoir le fil, bonsoir le forum,

Pourrais-tu, avec une capture d'écran ou en tapant le texte, nous expliquer qu'elle est la condition en colonne A qui fait que tu concatènes ou pas ?
02/01/2015, 22h59
tam938

Bonjour,

Dans la colonne "A", j'y ai mis des codes. Chaque code a des adresses (colonne "B") positionnées l'une après l'autre.
Par exemple, dans le fichier, le code "938" a 2 adresses : toto@toto.com,tata@tata.com,
le code "951" a 3 adresses: tonton@tonton.comtoto@toto.com,tata@tata.com,

Donc je veux que les adresses de la colonne "B" soient concaténées par adresse.

Cordialement,

POUBADY Ratna
03/01/2015, 01h30
Thautheme
Bonsoir le fil, bonsoir le forum,

Pas encore tout a fait clair... Est-ce que dans la colonne A tu répètes le code :
```
A     B
125    Adresse1
125    Adresse2  
358    Adresse1
358    Adresse2
```
ou tu as des blancs :
```
A     B
125    Adresse1
       Adresse2
358    Adresse1
       Adresse2
```
et est-ce que le résultat désiré serait :
```
A     B
125    Adresse1,Adresse2
358    Adresse1,Adresse2
```
03/01/2015, 13h58
tam938
Bonjour,

Le 3° est le résultat que je souhaite obtenir :

et est-ce que le résultat désiré serait :
```
A      B
125    Adresse1,Adresse2
358    Adresse1,Adresse2
```
Attention: chaque code n'a pas le même nombre d'adresse.

Merci :)

Bonsoir le fil, bonsoir le forum,

Tam, comme tu n'as pas daigné répondre à ma question te demandant si tu répétais les codes ou si tu laissais des blancs, je te propose un code qui ne marche que si tu répètes le code à chaque ligne. J'espère que c'est ton cas...

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
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim LD As Variant 'déclare la variable LD (Liste sans Doublon)
Dim K As Integer 'déclare la variable K (incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TF() As Variant 'déclare la variable TF (Tableau Final)
 
Set O = Sheets("Feuil1") 'définit l'onglet O (à adapter)
TC = O.Range("A1").CurrentRegion 'définit le tableau de celllule TC (à dapater)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC
    D(TC(I, 1)) = "" 'alimente le dictionnaire D
Next I 'prochaine ligne de la boucle
LD = D.keys 'récupère dans la tableau LS la liste des éléments sans doublon
K = 1 'initialise la variable K
For J = 0 To UBound(LD, 1) 'boucle 1 : sur tous les éléments de la liste LD
    For I = 1 To UBound(TC, 1) 'boucle 2 sur toutes les lignes du tabelau TC
        If LD(J) = TC(I, 1) Then 'condition : si l'élément de la liste LD est égal à la valeur en colonne A du tableau TC
            ReDim Preserve TF(1 To 2, 1 To K) 'redimensionne le tableau final TF
            TF(1, K) = TC(I, 1) 'récupère le code dans la première ligne de TF
            'récupère la ou les adresses dans la seconde ligne de TF
            TF(2, K) = IIf(TF(2, K) = "", TC(I, 2), TF(2, K) & "," & TC(I, 2))
        End If 'fin de la condition
    Next I 'prochaine ligne du tableau TC
    K = K + 1 'incrémente K (pour passer au code suivant)
Next J 'prochain élément de la liste LD
O.Cells.Cells.ClearContents 'efface le contenu de l'onglet O
'transpoe dans A1 de l'onglet O le tableau TF
O.Range("A1").Resize(UBound(TF, 2), UBound(TF, 1)) = Application.Transpose(TF)
End Sub

03/01/2015, 21h53
tam938

Merci Tauthème.
En effet, j'ai omis de répondre à ta question en me concentrant sur le résultat. Désolée.
Je vais essayer le code et te tiens informé.

Tam938
05/01/2015, 09h43
tam938

Bonjour Thauthème,

Je viens de tester le code que tu m'as proposé.
Je rencontre le message suivant: "Erreur d'exécution '1004': Erreur définie pour l'application ou pour l'objet."

Et toutes les données de la feuille sont effacées.
Saurais-tu pourquoi ?

Tam938
05/01/2015, 12h14
Thautheme

Bonjour Tam, bonjour le forum,

C'est l'avant dernière ligne (nº 30) qui efface tout avant de transposer les données.
Écoute, je sais que la politique de ce site ne préconise pas les fichiers en pièce jointes (c'est pas très commode) et si de ton coté tu ne fais aucun effort on ne va pas s'en sortir. Essaie de me présenter un exemple avec juste 3 ou quatre lignes comme je l'ai fait moi-même et avec le résultat désiré.
Veux-tu le résultat dans le même onglet ou dans un autre onglet ? Lequel ?
05/01/2015, 14h07
Marc-L

Bonjour Thauthème,

le site n'aime pas lors du premier post voir une pièce jointe comme de la barbaque jetée en pâture à des chiens affamés
et démerdez-vous !

Lorsqu'un intervenant en ressent le besoin, pas de souci pour demander de joindre un classeur avec une feuille source
et une feuille du résultat escompté …
06/01/2015, 11h32
Thautheme

Bonjour le fil, bonjour le forum,

Citation:

Envoyé par Marc-L

Bonjour Thauthème,

le site n'aime pas lors du premier post voir une pièce jointe comme de la barbaque jetée en pâture à des chiens affamés
et démerdez-vous !

Brillant !... Moi quand j'ai faim je prends tout, la pâture, la pâtée, la jetée, voire même le pou et le hibou...