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

ralph45

XLDnaute Impliqué
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 !
 

Fichiers joints

Dernière édition:

ralph45

XLDnaute Impliqué
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

XLDnaute Barbatruc
Bonjour ralph45, Bruno,

Voyez le fichier joint et la macro du bouton :
VB:
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+
 

Fichiers joints

ralph45

XLDnaute Impliqué
(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 ?? :rolleyes:
 

Fichiers joints

job75

XLDnaute Barbatruc
Oui bon d'accord, alors il suffit de remplacer :
VB:
        tablo(i, 4) = Len(tablo(i, 3)) - Len(Replace(tablo(i, 3), ";", "")) + 1
par :
Code:
        tablo(i, 4) = Len(tablo(i, 3)) - Len(Replace(tablo(i, 3), ";", "")) + Sgn(Len(tablo(i, 3)))
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas