Option Compare Text 'si l'on veut que la casse soit ignorée
Sub CompteValeursUniques()
Dim t, tc, ub&, i&, e, j&, n&
t = [A1:A50] 'à adapter
tc = [A51:A100] 'à adapter
ub = UBound(t)
For i = 1 To ub
If t(i, 1) <> "" Then
For Each e In tc
If t(i, 1) = e Then t(i, 1) = Empty: GoTo 1
Next
For j = i + 1 To ub
If t(j, 1) = t(i, 1) Then t(j, 1) = Empty
Next
n = n + 1
End If
1 Next
[B2].Resize(ub) = t 'restitution
[B:B].Sort [B1], Header:=xlYes 'tri
MsgBox "Nombre de valeurs uniques " & n, , "Résultat"
End Sub