Recherche et concatenation

[jero]

Bonjour à toutes et à tous,

J'aurais souhaité un petit renseignement à savoir :

j'utilise un feuille Excel qui contient dans la colonne A des données qui reviennent plusieurs fois, et dans la colonne B j'ai des données différentes pour chaque doublons de la colonne A donc je souhaiterais supprimer les doublons de la colonne A pour ne garder qu'une seule ligne et en concaténant donc les différentes données de la colonne B sur une cellule dans la colonne C correspondant aux données de la colonne A.

Si je suis assez explicite, est ce que cela est possible ?

Merci.

 

[LPandre]

Re : Recherche et concatenation

Bonjour le forum,

à priori aucune difficulté, mais un bout de ton fichier zippé, permettrait de te faire du "coussu main".

@+ te lire

 

[jero]

Re : Recherche et concatenation

Merci de m'avoir répondu.

Voilà un exemple de ce que je souhaiterais faire et obtenir.

 

[LPandre]

Re : Recherche et concatenation

re :

Oulà ! Plus compliqué que ce que j'avais compris moi.
Avec des formules RechercheV et autres index Equiv, ça va pas le faire (sauf avis contraire). Faudrait une macro, et là... c'est plus pour moi

@+

Cordialement

 

[jero]

Re : Recherche et concatenation

Merci beaucoup à toi LPandre.

Si quelqu'un pourrait me dire si ce que je souhaite faire est possible et peut être me donner un petit coup de main.

Merci.

 

[skoobi]

Re : Recherche et concatenation

Bonjour,

voici une proposition par macro:

Sub Macro1()
Range([A3], [B3].End(xlDown)).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
couleur = ""
For Each cel In Range([A3], [A3].End(xlDown))
    If cel.Row = 3 Then couleur = cel.Offset(0, 1).Value
    If cel.Value <> cel.Offset(-1, 0).Value Then
        couleur = cel.Offset(0, 1).Value
    ElseIf cel.Value = cel.Offset(-1, 0).Value Then
        couleur = couleur & "," & cel.Offset(0, 1).Value
    End If
    If cel.Value <> cel.Offset(1, 0).Value And cel.Value = cel.Offset(-1, 0).Value Then
        'couleur = couleur & "," & cel.Offset(0, 1).Value
        cel.Offset(0, 1).Value = couleur
    End If
Next
derlig = Range("A3").End(xlDown).Row
For lig = derlig To 3 Step -1
    If Cells(lig, 1).Value = Cells(lig, 1).Offset(1, 0).Value Then Cells(lig, 1).Resize(1, 2).Delete shift:=xlShiftUp
Next
End Sub

 

[jero]

Re : Recherche et concatenation

Merci beaucoup Skoobi pour ta macro, elle fonctionne à merveille sur mon exemple mais bien entendu cet exemple n'est qu'un extrait du fichier que j'aurais à traiter et n'étant pas très à l'aise avec le Vba pourrais tu me dire sans vouloir abuser la ligne que je devrais modifier afin que je puisse l'utiliser avec l'exemple ci dessous.

Merci beaucoup.

 

[jero]

Re : Recherche et concatenation

J'ai oublié de joindre le fichier, alors le voilà.

 

[skoobi]

Re : Recherche et concatenation

Re bonjour,

en rouge ce qu'il faut modifier:

Sub Macro1()
Range([A3], [[B][COLOR="Red"]E[/COLOR][/B]3].End(xlDown)).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
couleur = ""
For Each cel In Range([A3], [A3].End(xlDown))
    If cel.Row = 3 Then couleur = cel.Offset(0, [B][COLOR="red"]3[/COLOR][/B]).Value
    If cel.Value <> cel.Offset(-1, 0).Value Then
        couleur = cel.Offset(0, [B][COLOR="red"]3[/COLOR][/B]).Value
    ElseIf cel.Value = cel.Offset(-1, 0).Value Then
        couleur = couleur & "," & cel.Offset(0, [B][COLOR="red"]3[/COLOR][/B]).Value
    End If
    If cel.Value <> cel.Offset(1, 0).Value And cel.Value = cel.Offset(-1, 0).Value Then
        'couleur = couleur & "," & cel.Offset(0, 1).Value
        cel.Offset(0, 3).Value = couleur
    End If
Next
derlig = Range("A3").End(xlDown).Row
For lig = derlig To 3 Step -1
    If Cells(lig, 1).Value = Cells(lig, 1).Offset(1, 0).Value Then Cells(lig, 1).Resize(1, [B][COLOR="red"]5[/COLOR][/B]).Delete shift:=xlShiftUp
Next
End Sub

Voilà

 

[jero]

Re : Recherche et concatenation

Super merci beaucoup Skoobi...

 

[ampirus]

Re : Recherche et concatenation

Skoobi, merci d'avance parce que j'avais le même souci, je vais teste ta macro, merci a jero aussi, pour avoir bien exposer le problème