1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
| Sub verif()
Dim unique As New Collection
Dim F1 As Worksheet
Dim F2 As Worksheet
Application.ScreenUpdating = False
Set F1 = Sheets("Donnees")
Set F2 = Sheets("Test")
Set d = CreateObject("Scripting.Dictionary")
TblBD = F1.Range("D4:F" & F1.[D65000].End(xlUp).Row)
For i = 1 To UBound(TblBD)
clé = TblBD(i, 3)
d(clé) = d(clé) + TblBD(i, 1)
Next i
F2.[B7].Resize(d.Count) = Application.Transpose(d.keys)
F2.[C7].Resize(d.Count) = Application.Transpose(d.items)
Application.ScreenUpdating = True
F2.Select
End Sub |
Partager