Concatenage multiple

[ted1057]

Bonjour à la communauté,

Je travaille sur un tableau EXCEL qui me permettra d'identifier les clients par rapport à un numéro d'AR fournisseur.Recevant chaque semaine une liste d'AR fournisseur disponible, je dois rechercher manuellement les clients associés.
Un AR fournisseur pouvant être lié à un ou plusieurs clients.

Exemple l'AR fournisseur 1641879 peut être affecté à Paul, Arthur et Cyril.

Je souhaiterais, voir Fichier Excel, un résultat du genre
Colonne A Colonne B
AR fournisseur Paul / Arthur / Cyril

 

[Modeste]

Bonjour ted1057,

Une solution par macro ...
Insérer les lignes suivantes dans un module standard:

Sub clients()
Set liste = CreateObject("scripting.dictionary")
For lig = 2 To Feuil1.Cells(Rows.Count, 4).End(xlUp).Row
    liste(Feuil1.Cells(lig, 4).Value) = liste(Feuil1.Cells(lig, 4).Value) & _
        IIf(liste.exists(Feuil1.Cells(lig, 4).Value), "/", "") & Feuil1.Cells(lig, 2).Value
Next lig
Feuil2.[A2].Resize(liste.Count, 1) = Application.Transpose(liste.Keys)
Feuil2.[F2].Resize(liste.Count, 1) = Application.Transpose(liste.items)
End Sub

[Edit:] Salut JM 🙂, salut Paf 🙂

 

[Paf]

bonjour ted1057

un essai par fonction personnalisée:

en F2: =Client(A2) à tirer vers le bas

dans un module standard

Function Client(Fournisseur)
Dim Tablo, i As Long, Concat As String
With Worksheets("Suivi commande")
Tablo = .Range("B2:D" & .Range("B" & Rows.Count).End(xlUp).Row)
End With
For i = LBound(Tablo) To UBound(Tablo)
    If Tablo(i, 3) = Fournisseur Then Concat = Concat & IIf(Len(Concat) > 0, " / ", "") & Tablo(i, 1)
Next
Client = Concat
End Function

A+

Edit : Bonjour Modeste

 

[Paf]

Re,

dans la mesure ou la liste des fournisseurs change chaque semaine, il vaut mieux, plutôt que la fonction personnalisée, utiliser une macro de ce type:

Sub Clients()
 Dim TabloC, TabloF, TabloFC, i As Long, Concat As String
 With Worksheets("Suivi commande")
 TabloFC = .Range("B2:D" & .Range("B" & Rows.Count).End(xlUp).Row)
 End With
 With Worksheets("AR fournisseur")
 TabloF = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
 ReDim TabloC(1 To UBound(TabloF))
 For i = LBound(TabloF) To UBound(TabloF)
  For j = LBound(TabloFC) To UBound(TabloFC)
  If TabloF(i, 1) = TabloFC(j, 3) Then TabloC(i) = TabloC(i) & IIf(Len(TabloC(i)) > 0, " / ", "") & TabloFC(j, 1)
  Next
 Next
 .Range("F2").Resize(UBound(TabloC, 1), 1) = Application.Transpose(TabloC)
 End With
End Sub

A+

 

[ted1057]

Bonjour à la communauté;

Grand merci à tous vos commentaires et programme. Ils fonctionnent impeccable et cela me permet de gagner énormément de temps dans la suite de mon fichier et cela va grandement m'aider au quotidien.