Transposer des colonnes en ligne mais avec suppression de doublon

Bonjour le forum. Je suis plutôt débutant niveau "+" en macro. La je sèche sévère sur une transposition. En effet faire une transposition je sais faire. Mais dans mon cas la transposition est plus complexe.

En effet en colonne A j'ai des noms de clients parfois qui peuvent se répéter

En colonne B j'ai les emails correspondant de ces clients.

Je cherche à n'avoir qu'un seul ligne par client et mettre les différents emails client à la suite dans des colonnes donc B puis C puis D. J'ai mis un exemple dans le fichier joint. a gauche la base et à droite la cible en terme de résultats

J'avoue ne pas savoir du tout comment attaquer le sujet. Si vous avez des idées ?

Merci

Bonjour à tous,

Version excel ??

Crdlmt

Bonjour,

Suivant la version bien sur,

Un essai avec Power Query

EDIT : non conforme à la demande

Bonjour à tous!

Une proposition (Pour Excel 365 et +) :

Nouvelle version :

Bonjour tout le monde,

Avec une macro de l'excellent gmb ,

Option Explicit

Dim tablo, tabloR(), dico As Object, k
Dim i&, n&, d&, colMax&

 Sub gmb()

    tablo = Sheets("Feuil1").Range("A1").CurrentRegion
    Set dico = CreateObject("Scripting.Dictionary")

    colMax = 1
    For i = 1 To UBound(tablo, 1)
        If dico.exists(tablo(i, 1)) Then
            dico(tablo(i, 1)) = dico(tablo(i, 1)) + 1
            If dico(tablo(i, 1)) > colMax Then colMax = dico(tablo(i, 1))
        Else
            dico(tablo(i, 1)) = 1
        End If
    Next i

    k = dico.keys

    ReDim tabloR(1 To dico.Count, 1 To colMax + 1)
    For n = 0 To dico.Count - 1
        tabloR(n + 1, 1) = k(n)
        For i = 1 To UBound(tablo, 1)
            d = 0
            If tablo(i, 1) = k(n) Then
                While tabloR(n + 1, d + 1) <> ""
                    d = d + 1
                Wend
                tabloR(n + 1, d + 1) = tablo(i, 2)
            End If
        Next i
    Next n
    Range("H1").Resize(UBound(tabloR, 1), UBound(tabloR, 2)) = tabloR
End Sub

Cordialement,

@DjiDji59430 c'est version 365

@JB_ je découvre le power query c'est dans excel ? ou c'est un add-on ?

LouisDF a écrit :

@DjiDji59430 c'est version 365

alors

=TRANSPOSE(FILTRE($B$2:$B$7;$A$2:$A$7=H8))

mets a jour ton compte!

Crdlmt

@DjiDji59430 merci pour la fonction transpose. Par contre je dois retaper les clients à la main. et comme j'ai 1000 ligne environ je ne vois pas comment faire ?

Bonsoir à tous !

LouisDF a écrit :

Par contre je dois retaper les clients à la main. et comme j'ai 1000 ligne environ je ne vois pas comment faire ?

Que pensez-vous de mon usage de la fonction UNIQUE ?

@JB_ je découvre le power query c'est dans excel ? ou c'est un add-on ?

RE, oui intégré dans Excel, tu peux allez dans mon fichier puis onglet données et ensuite "requêtes et connexions"

Question à part, comment fait on pour faire des citations du genre "à écrit : " ?

Re,

@xorsankukai la macro est bigrement efficace. Par contre comme je disais dans le commentaire précédent avec la ligne de code suivante

Range("H1").Resize(UBound(tabloR, 1), UBound(tabloR, 2)) = tabloR

cela recopie en H1 alors que je souhaite plutôt écraser ou alors au pire créer dans un autre onglet ?

y a t'il une solution ?

Option Explicit

Dim tablo, tabloR(), dico As Object, k
Dim i&, n&, d&, colMax&

 Sub gmb()

    tablo = Sheets("Feuil1").Range("A1").CurrentRegion
    Set dico = CreateObject("Scripting.Dictionary")

    colMax = 1
    For i = 1 To UBound(tablo, 1)
        If dico.exists(tablo(i, 1)) Then
            dico(tablo(i, 1)) = dico(tablo(i, 1)) + 1
            If dico(tablo(i, 1)) > colMax Then colMax = dico(tablo(i, 1))
        Else
            dico(tablo(i, 1)) = 1
        End If
    Next i

    k = dico.keys

    ReDim tabloR(1 To dico.Count, 1 To colMax + 1)
    For n = 0 To dico.Count - 1
        tabloR(n + 1, 1) = k(n)
        For i = 1 To UBound(tablo, 1)
            d = 0
            If tablo(i, 1) = k(n) Then
                While tabloR(n + 1, d + 1) <> ""
                    d = d + 1
                Wend
                tabloR(n + 1, d + 1) = tablo(i, 2)
            End If
        Next i
    Next n
    Cells.ClearContents
    Range("A1").Resize(UBound(tabloR, 1), UBound(tabloR, 2)) = tabloR
End Sub

Cordialement,

Bonsoir de nouveau !

JB_ a écrit :

Question à part, comment fait on pour faire des citations du genre "à écrit : " ?

Voir le surlignage jaune !

Merci JFL

J'ai pas ça, juste les 2 premières icônes

EDIT : Il faut avoir posté au moins 500 messages !

https://forum.excel-pratique.com/forum/infos-fonctionnalites-sur-le-nouveau-forum-139662

LouisDF a écrit :

@DjiDji59430 merci pour la fonction transpose. Par contre je dois retaper les clients à la main. et comme j'ai 1000 ligne environ je ne vois pas comment faire ?

tu copies/colle la liste des clients et tu fais supprimer les doublons

Crdlmt

Bonjour à tous !

DjiDji59430 a écrit :

LouisDF a écrit :

@DjiDji59430 merci pour la fonction transpose. Par contre je dois retaper les clients à la main. et comme j'ai 1000 ligne environ je ne vois pas comment faire ?

tu copies/colle la liste des clients et tu fais supprimer les doublons

Crdlmt

Notre ami est censé utiliser Excel 365. Il a donc la fonction UNIQUE à sa disposition comme déjà indiqué plus haut......

merci à tous et particulièrement à @JFL. J'ai pu adapter à mon besoin.

Bonne fin de journée

Bonjour à tous !

Je vous remercie de ce retour.