Sub NbInit()
Application.Calculation = xlCalculationManual
Dim tablo() As Variant
Dim dico As Object
Dim Liste As Variant
Dim fin As Integer
Dim ele As Variant
Dim i As Integer
Dim a
Set dico = CreateObject("scripting.dictionary")
With ActiveSheet
fin = .UsedRange.Rows.Count
tablo = .Range("B2:C" & fin).Value
For i = LBound(tablo, 1) To UBound(tablo, 1)
If Not dico.exists(tablo(i, 2)) And tablo(i, 2) <> "" Then
dico.Add tablo(i, 2), 0
End If
Next i
For i = LBound(tablo, 1) To UBound(tablo, 1)
Liste = Split(tablo(i, 1), ",")
For Each ele In Liste
If ele <> "" Then
dico.Item(Trim(ele)) = dico.Item(Trim(ele)) + 1
End If
Next ele
Next i
For Each ele In dico.keys
.Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = ele & "," & dico.Item(ele)
Next ele
End With
Application.Calculation = xlCalculationAutomatic
End Sub