Private Sub cmb_Noms_Change()
Dim x$, tablo, d As Object, i&, a, b, c()
ListBox1.Clear
x = cmb_Noms
If x = "" Then Exit Sub
tablo = [Tableau1] 'tableau structuré
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
If tablo(i, 2) = x Then d(tablo(i, 1)) = d(tablo(i, 1)) + 1 'comptage
Next i
If d.Count = 0 Then Exit Sub
a = d.keys: b = d.items
ReDim c(UBound(a), 1) 'base 0
For i = 0 To UBound(a)
c(i, 0) = a(i)
c(i, 1) = b(i)
Next i
ListBox1.List = c
End Sub