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)))
 

Discussions similaires


Haut Bas