Sub EnLigne()
Dim a, t, i&, n&, s$, ref
Application.ScreenUpdating = False
[d1].CurrentRegion.Clear
a = [a1].CurrentRegion
[a1].CurrentRegion.Sort key1:=[a1], order1:=xlAscending, key2:=[b1], order2:=xlAscending, Header:=xlYes
t = [a1].CurrentRegion.Resize([a1].CurrentRegion.Rows.Count + 1)
[a1].CurrentRegion = a: Erase a
ref = t(1, 1): s = t(1, 1) & ";" & t(1, 2): n = 0
For i = 2 To UBound(t)
If t(i, 1) = ref Then
s = s & ";" & t(i, 2)
Else
n = n + 1
Cells(n, "d") = s
ref = t(i, 1): s = ref & ";" & t(i, 2)
End If
Next i
[d1].CurrentRegion.TextToColumns Semicolon:=True
[d1].CurrentRegion.Borders.LineStyle = xlContinuous
End Sub
Sub Transposer_Dico()
Dim f As Worksheet, vArr, i&
Set f = Sheets("Feuil2") 'nom feuille à adapter selon besoin
vArr = ActiveSheet.Range("A1").CurrentRegion.Value2
With CreateObject("scripting.dictionary")
For i = 2 To UBound(vArr)
.Item(vArr(i, 1)) = .Item(vArr(i, 1)) & vArr(i, 2) & "£"
Next i
f.Cells(1).Resize(.Count, 2) = Application.Transpose(Array(.Keys, .Items))
f.Columns(2).TextToColumns Range("B1"), xlDelimited, , , 0, 0, 0, 0, 1, "£"
End With
End Sub
Ai-je bien saisi ? Jeu de mots sanitaire ?Parce que le PQ, c'est l'avenir dans les cellules, non ?