Microsoft 365 Fusionner des lignes en doubles( avec ID comme clé )

[Jerry590]

Bonjour je viens vers vous car j'aimerais savoir si il existe une formule qui fusionne les ligne en double tout en gardant les informations des lignes(autre doublons).
je m'explique bien:

j'ai un fichier present comme suit(exemple) :
2564986 Iyves bal ouest paris daniel@gmail.com
2564986 yves bale sud

résultat que j'aimerais avoir est : 2564986 : Iyves yves I bal bale I ouest sud I paris I daniel@gmail.com

j'aimerais savoir s'il y a la solution dans un premier temps en formule ,et si cela nexiste pas le vba est la bien venu.

Merci pour votre compréhension

 

[merinos-BernardEtang]

Bonjour @Jerry590 ,
Bonjour le fofo,

C'est possible en une opération PowerQuery...
je groupe les lignes en présisant comment.

voir ce site explicatif

A+

Merinos

 

[merinos-BernardEtang]

La même solution avec un distinct sur les valeurs
(pour le nom sans tenir compte des majuscules pour le site on garde "Brest" et "brest")

 

[sylvanu]

Bonjour Jerry, Merinos,
Une autre approche en VBA.
Le résultat se fait en automatique par sélection de la feuil2, avec :

Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    ' Efface matrice résultat
    [A:F].ClearContents
    ' Transfert données dans feuil2 et tri sur ID, puis tranfert dans array, et efface matrice
    DL = Sheets("feuil1").Range("A65500").End(xlUp).Row
    Range("A1:F" & DL) = Sheets("feuil1").Range("A1:F" & DL).Value
    Range("A:F").Resize(DL).Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
    T = Range("A2:F" & DL)
    [A:F].ClearContents
    ' Comparaison ID et concaténation
    ReDim Tout(UBound(T)): IndTout = 0
    For L = 1 To UBound(T) - 1
        If T(L, 1) = T(L + 1, 1) Then
            Tout(IndTout) = T(L, 1)
            For i = 2 To 6
                Tout(IndTout) = Tout(IndTout) & " | " & T(L, i) & "  " & T(L + 1, i)
            Next i
            Tout(IndTout) = Mid(Tout(IndTout), 1, Len(Tout(IndTout)) - 1) ' Efface dernier |
            IndTout = IndTout + 1
        End If
    Next L
    ' Restitution array dans feuille et redimensionne colonne
    Range("A1").Resize(UBound(Tout)).Value = Application.Transpose(Tout)
    Columns.AutoFit
End Sub