Concatenage multiple

ted1057 · 24 Septembre 2016

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 · 24 Septembre 2016

Bonjour ted1057,

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

VB:

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 · 24 Septembre 2016

bonjour ted1057

un essai par fonction personnalisée:

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

dans un module standard

VB:

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 · 24 Septembre 2016

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:

VB:

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 · 25 Septembre 2016

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.

Concatenage multiple

ted1057

XLDnaute Occasionnel

Pièces jointes

Modeste

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

ted1057

XLDnaute Occasionnel

Discussions similaires