Function MemeActi(tablo As Range, acti1, acti2) As Long
Dim dico As New Dictionary, t, i&, n&
Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = TextCompare
t = tablo.Value
For i = 1 To UBound(t)
If t(i, 1) = acti1 Then dico(t(i, 2)) = ""
Next i
For i = 1 To UBound(t)
If t(i, 1) = acti2 Then If dico.Exists(t(i, 2)) Then n = n + 1: dico.Remove t(i, 2)
Next i
MemeActi = n
End Function