XL 2013 [VBA] Concaténation de multi-occurrences dans des cellules selon variables

[ralph45]

Bonjour les ami.e.s du forum,

Vous trouverez en PJ un fichier-exemple allégé et anonymisé, avec le maximum d'informations pour obtenir le résultat attendu.

--> L'idée est de concaténer et de comptabiliser dans plusieurs cellules, des données contenues (de 0 à n) dans un autre onglet selon une variable dans l'onglet original...

Merci d'avance !

 

[Compte Supprimé 979]

Bonjour Ralph45

Pourquoi ne pas utiliser un TCD !?

 

[ralph45]

Bonjour BrunoM45,

Effectivement, mais... comme ce fichier sera partagé avec plusieurs personnes pour lesquelles la simple dénomination et/ou vue d'un TCD les fera fuir (si, si ça existe ! 🙂 ) !!

Je désirerai leur proposer une solution simple, en "apparence" et ergonomie avec un bouton d'action pour gérer le tout.

R@lph

 

[job75]

Bonjour ralph45, Bruno,

Voyez le fichier joint et la macro du bouton :

Sub MAJ()
Dim tablo, d As Object, i&
With Sheets("SOURCE").[A1].CurrentRegion
    .Sort .Columns(2), xlAscending, .Columns(1), , xlAscending, Header:=xlYes 'tri
    tablo = .Resize(, 2)
End With
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
    If d.exists(tablo(i, 2)) Then
        d(tablo(i, 2)) = d(tablo(i, 2)) & " ; " & tablo(i, 1)
    Else
        d(tablo(i, 2)) = tablo(i, 1)
    End If
Next
With Sheets("LISTE").[A1].CurrentRegion.Resize(, 4)
    tablo = .Value
    For i = 2 To UBound(tablo)
        tablo(i, 3) = d(tablo(i, 1))
        tablo(i, 4) = Len(tablo(i, 3)) - Len(Replace(tablo(i, 3), ";", "")) + 1
    Next
    .Value = tablo
End With
End Sub

A+

 

[ralph45]

Bonsoir job75,

Ton code fonctionne parfaitement ! Je te remercie !

 

[ralph45]

(Re) Bonjour @tou.te.s

Le code ci dessus fonctionne bien avec mon fichier d'origine.
Par contre, adapté à un autre (avec la même structure, il me semble), il ne me renvoie pas les résultats escomptés...

WTF ?? 🙄

 

[job75]

Oui bon d'accord, alors il suffit de remplacer :

        tablo(i, 4) = Len(tablo(i, 3)) - Len(Replace(tablo(i, 3), ";", "")) + 1

par :

        tablo(i, 4) = Len(tablo(i, 3)) - Len(Replace(tablo(i, 3), ";", "")) + Sgn(Len(tablo(i, 3)))