Bonjour à tous,
je m'excuse de remettre ce post au goût du jour mais j'avais juste une petite requête à demander à Mr BOISGONTIER.
J'utilise sa macro ci-dessous et en fait j'aimerais avoir une version qui ne prend pas seulement les valeurs uniques mais toutes les valeurs.
J'ai beau tenter de modifier la macro mais je n'y arrive pas.
En vous remerciant par avance pour votre aide.
Cordialement
Sub RegroupeUniquesCode2() ' 0,32 sec
Set f = Sheets("base")
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Tbl = f.Range("A2
" & f.[a65000].End(xlUp).Row).Value
For i = LBound(Tbl) To UBound(Tbl) ' élimination doublons nuances
If Tbl(i, 4) <> "" Then d1("'" & Tbl(i, 1) & "|" & Tbl(i, 4)) = ""
Next i
For Each c In d1.keys ' regroupement par code
a = Split(c, "|")
d(a(0)) = d(a(0)) & a(1) & "|"
Next c
Set f2 = Sheets("résultat")
Tbl2 = f2.Range("c2:c" & f.[c65000].End(xlUp).Row).Value
For i = LBound(Tbl2) To UBound(Tbl2) ' élimination doublons nuances
tmp = "'" & Tbl2(i, 1)
If d.exists(tmp) Then x = d(tmp) Else x = ""
d2(tmp) = x
Next i
f2.[e2].Resize(d2.Count) = Application.Transpose(d2.items)
Application.DisplayAlerts = False
f2.[e2].Resize(d2.Count).TextToColumns Other:=True, OtherChar:="|"
f2.Cells.EntireRow.AutoFit
End Sub