Sub comptage()
Application.Calculation = False
Set dico = CreateObject("Scripting.Dictionary")
a = [famille]
For i = LBound(a) To UBound(a)
b = Split(a(i, 1), "-")(1)
dico(b) = dico(b) + 1
Next i
[H2].Resize(dico.Count, 1) = Application.Transpose(dico.keys)
[I2].Resize(dico.Count, 1) = Application.Transpose(dico.items)
[H1].Sort Key1:=[H2], Order1:=xlAscending, Header:=xlYes
Application.Calculation = True
End Sub