[Résolu] RechercheV avec occurrences + concaténation

[sandrabordeaux]

Bonjour à toutes et à tous.
Je me permets de solliciter votre aide pour une fonction que je tente de réaliser depuis 5 heures déjà.
J'ai essayé toutes les réponses déjà apportées dans les différents fils de discussion présents sur votre forum et sur les recherches Google.
j'ai un gros volume de données à trier et je ne m'en sors pas !
Je vous explique :
j'ai une liste d'expressions en colonne 1 avec chacune 1 attribut associé en colonne 2.
Je cherche à lister l'ensemble des attributs pour chaque expression de la forme :
Expression col 1 > attribut 1 | attribut 2 | attribut 3 |...
je n'ai jamais le même nombre de d'attributs ni le même nombre d'expressions différentes en colonne 1.
j'ai tout tenté (vba and co) je n'en vois pas le bout (et j'ai plusieurs milliers d'expressions à associer à leurs attributs).
J'ai pris soin de vous glisser un fichier d'exemple en pièce jointe pour essayer de mieux me faire comprendre.
Je vous remercie d'avance !!!
Sandra

 

[Nairolf]

Re : RechercheV avec occurrences + concaténation

Salut,

Essaye avec le fichier joint (dernier onglet).
Ce n'est pas parfait, mais ça marche en passant par une colonne intermédiaire.

 

[sandrabordeaux]

Re : RechercheV avec occurrences + concaténation

Merci je regarde ça, ça me dépannera en attendant de trouver une solution plus concise.
mais c'est déjà parfait pour répondre à mon besoin ;-)

 

[gosselien]

Re : RechercheV avec occurrences + concaténation

Bonjour le forum,

par un tableau (plus rapide 🙂 )

P.

 

[sandrabordeaux]

Re : RechercheV avec occurrences + concaténation

Merci beaucoup c'est parfait, j'ai 2 solutions qui fonctionnent !
Bon week end à vous

 

[klin89]

Re : [Résolu] RechercheV avec occurrences + concaténation

Bonsoir à tous,

Vois ceci :

Option Explicit

Sub Concatenate()
Dim a, i As Long, j As Long, n As Long
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMOde = 1
            For i = 1 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    n = n + 1: .Item(a(i, 1)) = n
                    For j = 1 To 2
                        a(n, j) = a(i, j)
                    Next
                Else
                    'a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) & vbLf & a(i, 2)
                    a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) & "|" & a(i, 2)
                End If
            Next
        End With
    End With
    With Sheets("Feuil2").Range("a1")
        .CurrentRegion.Clear
        With .Resize(n, UBound(a, 2))
            .Value = a
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .Borders.Weight = 2
        End With
        With .CurrentRegion.Rows(1)
            .Interior.ColorIndex = 43
            .Font.Size = 11
        End With
        .Parent.Select
    End With
    Application.ScreenUpdating = True
End Sub

klin89