Concatener les doublons

Bonjour à toutes et tous,

Je ne suis pas bonne du tout en excel et j'ai un boulot à rendre prochainement, avis aux âmes charitables

Voilà, j'ai un fichier comprenant en colonne A des emails, en colonne B des téléphones et en colonnes C des secteurs d'activités.

Ce qu'il me faut comme résultat c'est obtenir un fichier excel où pour tous les emails en doublon on concatene les secteurs d'activités.

Ex : Si l'email de monsieur Durand apparait 10 fois avec 10 secteurs d'activités différents, je souhaite que la formule me permette de me retrouver avec un fichier où l'email de monsieur Durand n'apparait plus qu'une seule fois et où les 10 secteurs d'activités on été concatenés dans une seule et même cellule.

Ps : j'ai déjà évidemment dédoublonné le fichier des lignes où l'email et le secteur d'activité sont strictement identiques.

Je pense que ce n'est pas très compliqué mais je n'ai pas les bons réflexes

Merci à vous

Cécile

Bonjour. Bienvenue sur le Forum

Tu as oublié de joindre le fichier

Cordialement

Bonsoir,

Un exemple à adapter avec tes données, car sans fichier joint

Option Explicit
Option Private Module
Public Sub test()
Dim wss As Worksheet, _
    wsd As Worksheet, _
    monDico, _
    c As Range, _
    d As Range, _
    firstAddress As String, _
    x As String

    Application.ScreenUpdating = False

    Set wss = Worksheets("Feuil1")
    Set wsd = Worksheets("Feuil2")
    Set monDico = CreateObject("Scripting.Dictionary")

    With wsd
        .Cells.Clear
        .[A1:B1] = Array("adresse", "Secteurs")
    End With

    With wss
        For Each c In .Range("A2:A" & .Range("A2").End(xlDown).Row)
            monDico(c.Value) = ""
        Next c
    End With

    wsd.[A2].Resize(monDico.Count, 1) = Application.Transpose(monDico.keys)

    With wsd
        For Each c In .Range("A2:A" & .Range("A2").End(xlDown).Row)
            .Hyperlinks.Add _
                    Anchor:=c, _
                    Address:="mailto:" & c.Value, _
                    TextToDisplay:=c.Value
        Next
    End With

    For Each c In wsd.Range("A2:A" & Range("A2").End(xlDown).Row)
        x = ""
        With wss.Range("A2:A" & Range("A2").End(xlDown).Row)
            Set d = .Find(c, LookIn:=xlValues)
            If Not d Is Nothing Then
                firstAddress = d.Address
                Do
                    x = x & ", " & d.Offset(0, 1)
                    Set d = .FindNext(d)
                Loop While Not d Is Nothing And d.Address <> firstAddress
            End If
        End With
        c.Offset(0, 1) = Mid(x, 3, Len(x))
    Next

    wsd.Activate
    [A1].Select

    Set wss = Nothing: Set wsd = Nothing: Set monDico = Nothing

End Sub

Merci pour votre réactivité !

Je ne savais pas que je pouvais joindre un fichier à ma demande.

Voici un morceau du fichier à toute petite échelle. J'ai mis le résultat attendu en bas du fichier.

Jean-Eric, c'est gentil de m'aider mais je ne te cache pas que ta "formule" sort pour moi de la quatrième dimension

J'ai plutôt l'habitude de formule avec "=A1& ""....." Là je ne comprends pas comment exploiter les infos que tu m'as communiquées...