XL 2013 Cmt afficher des valeurs liées à la suite dans une seule cellule

[Sofia Soa]

Bonjour à tous,

Comme beaucoup sur ce forum j'ai un soucis avec excel, je pense que mon problème peut être résolu avec une simple formule mais malheureusement je n'y arrive toujours pas.

Je souhaiterai afficher des valeurs liées à la suite dans une même cellule :

- j'ai une première colonne A avec des noms de fournisseurs
- une seconde colonne B avec le nom de la division à laquelle appartient ce fournisseur

Des fournisseurs peuvent appartenir à plusieurs divisions différentes , et ont donc plusieurs lignes

Dans une troisième colonne je souhaiterai avoir la liste des divisions du fournisseur séparées par une virgule. Il n'y aurait donc plus qu'une ligne par fournisseur .

Je dois trier une liste de plus 15000 fournisseurs , je ne peux donc pas le faire manuellement.

Vous pouvez trouver en pièce jointe un modèle du problème.

J'espère que vous pourrez m'aider et m'éviter de passer le weekend de paques sur ce problème

Merci beaucoup et bon weekend !

Sofia

 

[eddy1975]

Re : Cmt afficher des valeurs liées à la suite dans une seule cellule

Bonjour,

La fonction Concatener du style :
=Concatener(B1;",";B2;",";.........
pourrait résoudre ce problème. Cependant les filtres posent problème dans cette feuille pour pouvoir l'appliquer.
Il faut incrémenter des conditions pour éviter les doublons et faire en sorte que la fonction s'applique par rapport au nombre de lignes. cela dépasse mes compétences.
Bon courage

 

[job75]

Re : Cmt afficher des valeurs liées à la suite dans une seule cellule

Bonjour Sofia Soa, bienvenue sur XLD, salut eddy1975,

Alt+F11 pour aller dans VBA et placez où vous voulez cette macro :

Sub Fournisseurs()
Dim s$, t, rest$(), d As Object, i&, x$, y$, z$
s = ", " 'séparateur, à adapter
t = ActiveSheet.UsedRange.Resize(, 2)
ReDim rest(1 To UBound(t), 1 To 1)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  x = t(i, 1): y = t(i, 2)
  If x <> "" And y <> "" Then
    If Not d.exists(x) Then d(x) = i 'repère la ligne
    z = rest(d(x), 1)
    If InStr(s & z & s, s & y & s) = 0 Then _
      rest(d(x), 1) = IIf(z = "", "", z & s) & y
  End If
Next
ActiveSheet.[C1].Resize(UBound(t)) = rest
End Sub

La macro est très rapide car elle utilise des tableaux VBA.

Edit : sur 15000 lignes elle devrait s'exécuter en 1/10ème de seconde.

N'oubliez pas d'enregistrer le fichier en .xlsm

A+

 

[Sofia Soa]

Re : Cmt afficher des valeurs liées à la suite dans une seule cellule

Merci beaucoup pour la macro, cela fonctionne parfaitement !! Joyeux Lundi de Pâques

 

[CPk]

Re : Cmt afficher des valeurs liées à la suite dans une seule cellule

Bonjour, sensiblement la même chose que Job75 (que je salue) avec un résultat déporté sur une autre feuille.

Sub synthèse()
    Application.DisplayAlerts = False
    Dim f As Worksheet
    Dim dico As Object

    For Each f In Worksheets
        If f.Name = "Synthèse" Then f.Delete
    Next f

    Set dico = CreateObject("scripting.dictionary")
    dico.comparemode = 1

    a = Feuil1.UsedRange
    For i = 2 To UBound(a)
        If Not dico.exists(a(i, 1)) Then
            dico.Item(a(i, 1)) = a(i, 2)
        Else
            If InStr(1, dico.Item(a(i, 1)), a(i, 2), vbTextCompare) = 0 Then
                dico.Item(a(i, 1)) = dico.Item(a(i, 1)) & "," & a(i, 2)
            End If
        End If
    Next i
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Synthèse"
    With Sheets("Synthèse")
        .Cells(1, 1).Resize(1, 2) = Array(a(1, 1), a(1, 2))
        .Cells(2, 1).Resize(dico.Count) = Application.Transpose(dico.keys)
        .Cells(2, 2).Resize(dico.Count) = Application.Transpose(dico.items)
        .Columns("A:B").AutoFit
    End With

    Set dico = Nothing
    Set f = Nothing
    Application.DisplayAlerts = True
End Sub