XL 2016 cumuler plusieurs valeurs d'une cellule selon critère

dav30029

XLDnaute Nouveau
Bonjour,

J'ai joint un fichier pour expliquer la demande.

J'ai un ensemble de données dans la colonne A.(dans ce cas, j'en ai que quelques-unes)

J'ai fait un filtre avancé dans la colonne E(qui est également mon critère) pour extraire les valeurs uniques.

Le critère est la colonne E.

Pour chaque client extrait en colonne E, je voudrais cumuler en colonne F,le contenu de plusieurs cellules(colonne B) correspondant au même client

Je travaille sur office 2016 et à la fois sur office 365.
A l'écoute également des propositions via vba.

Merci pour votre aide
 

Pièces jointes

  • exemple.xlsx
    9.3 KB · Affichages: 5
Solution
Bonjour Dav,
Un essai en PJ avec :
VB:
Sub Consolide()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    Range("E1:E" & DL) = Range("A1:A" & DL).Value                               ' Copier Coller valeurs
    Range("F1:F" & DL).ClearContents                                            ' Efface colonne F
    ActiveSheet.Range("$E$1:$E$9").RemoveDuplicates Columns:=1, Header:=xlNo    ' Supprimer doublons
    tablo = Range("A2:B" & DL)                                                  ' Transfert données dans array
    Ligne = 2
    While Range("E" & Ligne) <> ""
        CodeClient = Range("E" & Ligne)                         ' Récupération code client
        Chaine = ""
        For i = 1 To UBound(tablo)...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Dav,
Un essai en PJ avec :
VB:
Sub Consolide()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    Range("E1:E" & DL) = Range("A1:A" & DL).Value                               ' Copier Coller valeurs
    Range("F1:F" & DL).ClearContents                                            ' Efface colonne F
    ActiveSheet.Range("$E$1:$E$9").RemoveDuplicates Columns:=1, Header:=xlNo    ' Supprimer doublons
    tablo = Range("A2:B" & DL)                                                  ' Transfert données dans array
    Ligne = 2
    While Range("E" & Ligne) <> ""
        CodeClient = Range("E" & Ligne)                         ' Récupération code client
        Chaine = ""
        For i = 1 To UBound(tablo)                              ' Parcourt le tablo
            If tablo(i, 1) = CodeClient Then                    ' Si code client détecté
                Chaine = Chaine & tablo(i, 2) & ";"             ' Ajout dans le résultat
            End If
        Next i
        Cells(Ligne, "F") = Mid(Chaine, 1, Len(Chaine) - 1)     ' Ecriture résultat sauf ";" final
        Ligne = Ligne + 1
    Wend
End Sub
Ce serait peut être plus lisible en mettant chaque détail dans une cellule séparée, sauf si vous voulez générer ensuite un csv.
 

Pièces jointes

  • exemple.xlsm
    16.7 KB · Affichages: 2

Discussions similaires