Concaténer cellules

Question

Bonjour, 

SVP, jai besoin de concaténer des cellules pour avoir le résultat mis en exergue ci-dessous à travers VBA

Pour toutes les cellules ayant l'intitulé A ou B ou C... concaténer toutes les cellules adjacentes


A   AAA     AAABBBCCC
A   BBB     AAABBBCCC
A   CCC    AAABBBCCC

B   DDD    DDDEEEFFF
B   EEE     DDDEEEFFF
B   FFF      DDDEEEFFF

Je vous remercie d'avance.


Configuration: Windows XP / Firefox 2.0.0.20

Vaucluse · Answer

Bonjour
pas clair, là on ne sait ni ce que vous avez dans les cellules, ni ce que vous voulez obtenir;
Le mieux serait de faire un petit modèle (avec donnée et type de résultat souhaité ) et de le placer sur:
http://www.cijoint.fr
en revenant ici placer le lien donné par le site.
à vous lire
crdlmnt

nabilinkin · Answer

Re;

Je vous remercie pour votre prompte réponse.

Le lien du fichier 

http://www.cijoint.fr/cjlink.php?file=cj201109/cijzmgYcu2.xlsx

Le résultat souhaité est sur la colonne C

A titre de précision,je travaille sur excel 2007.

cousinhub29 · Answer

Bonsoir, 

En partant du principe que chaque bloc à concaténer est séparé par une cellule vide, tu peux essayer ce code : 

Sub concat() 
Dim Ar As Range 
For Each Ar In Columns(2).SpecialCells(xlCellTypeConstants, 23).Areas 
    Ar.Offset(, 1) = Replace(Join(Application.Transpose(Ar.Areas(1).Value2)), " ", "") 
Next Ar 
End Sub 


Bonne soirée

cousinhub29 · Answer

Re-,

De l'utilité de joindre un fichier le plus proche possible de la structure réelle du fichier initial....

OK, je regarde

cousinhub29 · Answer

Re-,

En partant du principe que la colonne A est triée.....

Sub concat()
Dim Cel As Range, Ar As Range
Dim It
Dim LesTypes As Object
Set LesTypes = CreateObject("Scripting.Dictionary")
For Each Cel In Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    LesTypes(Cel.Value) = Cel.Value
Next Cel
For Each It In LesTypes.items
    ActiveWorkbook.Names.Add Name:="Hub", RefersToR1C1:= _
        "=OFFSET(Feuil1!R1C1,MATCH(""" & It & """,Feuil1!C1,0)-1,,COUNTIF(Feuil1!C1,""" & It & """))"
    Range("hub").Offset(, 3) = Join(Application.Transpose(Range("Hub").Offset(, 1).Areas(1).Value2), "")
Next It
ActiveWorkbook.Names("Hub").Delete
End Sub


Sinon, envoie un fichier vraiment au plus près de la structure réelle de ton fichier de travail...

Bonne soirée

Concaténer cellules

5 réponses

Discussions similaires

Newsletters