Passer plusieurs lignes au même attribut en une seule ligne avec séparateur

Bonjour,

Dur de mettre un titre moins flou :p

Je préfère imager ce que j'ai envie de faire, comme suit:

J'ai :

a | az

a | ae

a | ar

b | bv

b | bn

b | bg

b | bf

c | cg

c | ct

Et j'aimerais avoir:

a | az ; ae ; ar ; null

b | bv ; bn ; bg ; bf

c | cg ; ct ; null ; null

Merci d'avance pour votre aide !

Bonjour,

Une piste en admettant que les lettres à gauche de la barre verticale de ton exemple soient en colonne A et que les paires de lettres soient en colonne B et le résultat à partir de la colonne D :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim T
    Dim I As Integer
    Dim J As Integer
    Dim Max As Integer

    'plage des codes en colonne A de la feuille active
    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    'utilise un dictionnaire pour dédoublonner
    Set Dico = CreateObject("Scripting.Dictionary")

    For Each Cel In Plage: Dico(Cel.Value) = Dico(Cel.Value) & Cel.Offset(, 1).Value & ";": Next Cel

    Cle = Dico.Keys

    For I = 0 To Dico.Count - 1

        'supprime le dernier point-virgule
        Dico(Cle(I)) = Left(Dico(Cle(I)), Len(Dico(Cle(I))) - 1)

        'splite chaque valeur...
        T = Split(Dico(Cle(I)), ";")

        '...et recherche la dimension la plus grande
        If Max < UBound(T) Then Max = UBound(T)

    Next

    'inscrit les résultats dans les colonnes D à x
    For I = 0 To Dico.Count - 1

        T = Split(Dico(Cle(I)), ";")

        Cells(I + 1, 4).Value = Cle(I)

        For J = 0 To Max

            On Error Resume Next
            Cells(I + 1, J + 5).Value = T(J)
            If Err.Number <> 0 Then Cells(I + 1, J + 5).Value = "Null"

        Next J

    Next

End Sub