[VBA] - Compléter une cellule avec une liste d'informations

Bonjour,

J'ai des informations qui apparaissent dans une colonne (sur une autre feuille), elles se répètent plusieurs fois.

J'aimerais prendre 1 occurrence de chacune d'entre-elles et les lister à la suite, dans une autre cellule.

Le nombre d'informations renseignées dans cette colonne est variable, parfois 1, parfois 3 ; 5 ; etc.

Pour le moment je m'y prends ainsi, en VBA :

Je liste les informations dans une nouvelle colonne, je supprime les doublons et j'attribue pour chaque ligne (10 lignes max) une variable.

Ex :

Variable a = "info 1"

Variable b = "info 2"

Variable c = "info 3"

Etc.

Je demande ensuite à renseigner ces variables à la suite en utilisant la concaténation.

Est-ce qu'il existe une solution plus simple et plus propre pour aller chercher chaque valeur unique et les lister à la suite dans une cellule donnée ?

Je joins un petit document pour illustrer ce que je cherche à faire !

Bonne journée

Rebonjour,

ta feuille "résultat espéré" est vide, c'est normal? parce que du coup je n'arrive pas du tout à visualiser ce que tu souhaites obtenir

La feuille contient plusieurs en-têtes, dont 1 qui est mise en jaune ; c'est dans cette case là que le résultat apparaît

Re,

ah d'accord!

Dans ce cas je te propose ça:

Pense à augmenter la hauteur de la ligne pour voir le résultat

Bonjour,

Essaie avec cette macro ...

Sub En_tête()
Dim MonDico, t, k
Dim C As Range
Dim i As Long
Dim Texte As String
    Set MonDico = CreateObject("Scripting.Dictionary")
    Texte = "Impacts bruts" & Chr(10)
    With Worksheets("CSV")
        For Each C In .Range("AW2:AW" & .Range("AW" & Rows.Count).End(xlUp).Row)
            If C.Value <> "0" Then
            If Not MonDico.Exists(C.Value) Then MonDico.Add C.Value, C.Offset(, 1).Value
            End If
        Next C
    End With
    t = MonDico.items
    k = MonDico.keys
    For i = LBound(t) To UBound(t)
        Texte = Texte & k(i) & " - " & t(i) & Chr(10)
    Next i
    With Worksheets("VNEI (Impacts)").Range("F1")
        .Value = Left(Texte, Len(Texte) - 1)
        .Interior.ColorIndex = 6
    End With
End Sub

Cordialement.

Bonsoir,

Merci pour vos propositions ! Après plusieurs tests, ça fonctionne comme espéré

Merci pour votre aide, il ne me reste plus qu'à trouver comment faire fonctionner "Autofit" pour rendre visibles ces informations

Bonne fin d'après-midi !

Rechercher des sujets similaires à "vba completer liste informations"