1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
| Sub es()
Dim c, d, x As Variant, m As Object
Application.ScreenUpdating = False
Range("E2:f65000").ClearContents
Set m = CreateObject("Scripting.Dictionary")
For Each c In Range("A2", [a65000].End(xlUp))
m(c.Value) = IIf(m.Exists(c.Value), m(c.Value) + 1, 1)
Next c
[e2].Resize(m.Count, 1) = Application.Transpose(m.keys)
[e1] = "article": [f1] = "somme "
For Each c In Range("e2", [e65000].End(xlUp))
For Each d In Range("a1", [a65000].End(xlUp))
If c = d Then x = x + d.Offset(0, 1).Value
Next d
Range("f65536").End(xlUp)(2) = x
x = 0
Next c
[e2:f65000].Sort Key1:=Range("e2"), Order1:=xlAscending, Header:=xlGuess
End Sub |
Partager