XL 2010 Compter automatiquement le nombre de valeurs uniques

Option Base 1
Function NbContenaires(ByRef Res As Range)
Dim tabNb() As Variant ' Variable tableau
Dim T As Variant ' Variable tableau
Dim i As Double
Dim j As Integer
ReDim tabNb(1) ' Dimension de la variable tableau 1 Case
    'For i = Cells(7, 14).Row To Cells(Cells(65536, 1).End(xlUp).Row, 14).Row
1er ligne de la plage : Res.Row et dernière ligne de la plage : ((Res.Row + Res.Rows.Count) - 1)
For i = Res.Row To ((Res.Row + Res.Rows.Count) - 1)
        If Cells(i, Res.Column) Like "*" & "," & "*" Then ' Condition si la chaîne Caractère contient une virgule = ,
            T = Split(Cells(i, Res.Column), ",") ' Découpage de la chaîne Split envoyé dans la variable tableau T
            For j = LBound(T) To UBound(T) ' Boucle sur le Tableau T (Toutes les cases)
                tabNb(UBound(tabNb)) = T(j) ' Copie du résultat dans la variable tableau tabNb dimensionné plus haut.
                ReDim Preserve tabNb(UBound(tabNb) + 1) ' Ajout d'une nouvelle case pour la variable tableau tabNb soit +1 Case
            Next j
        Else
            tabNb(UBound(tabNb)) = Cells(i, Res.Column)  ' chaîne sans séparateur virgule stocké dans la variable tableau tabNb
            ReDim Preserve tabNb(UBound(tabNb) + 1) 'Ajout d'une nouvelle case pour la variable tableau tabNb soit +1 Case
        End If
    Next i
ReDim Preserve tabNb(UBound(tabNb) - 1) ' Suppression d'une case inutile de la variable tableau tabNb soit 1 case en moins  (Cause incrémentation de la boucle voir plus haut)
' TestDoublon
    'Cells(3, 40) = TestDoublon(tabNb)
    NbContenaires = TestDoublon(tabNb) ' ici Fonction TestDoublon avec l'envois du tableau tabNb afin de récupérer le résultat qui sera renvoyer dans excel
End Function
Function TestDoublon(ByRef tabNb() As Variant) As Double
Dim nb As Double
    For i = LBound(tabNb) To UBound(tabNb) ' Boucle sur toutes les cases du tableau
        For j = i + 1 To UBound(tabNb) '  Boucle sur toutes les cases du tableau a partir de la prochaine
            If tabNb(i) = tabNb(j) Then ' Compare si le résultat est déjà trouvé (il y aura une action)
                tabNb(i) = "" ' cette action et d'effacer le résultat de la case du tableau = voir indice i
            End If
        Next j
    Next i
    For i = LBound(tabNb) To UBound(tabNb) ' ici encore une boucle sur ce tableau
        If tabNb(i) <> "" Then ' une condition qui est de savoir si la case est non vide il y a une action a faire.
            nb = nb + 1 ' cette action et de compter les cases du tableau non vide
        End If
    Next i
TestDoublon = nb    ' ici je revois le Nombre obtenu dans la fonction plus haut (c'est a dire celle-ci NbContenaires = TestDoublon(tabNb) ) est comme dit renverra le résultat dans excel !
End Function

Option Base 1
Function NbContenairesFiltré(ByRef Res As Range)
Dim tabNb() As Variant
Dim T As Variant
Dim i As Double
Dim j As Integer
ReDim tabNb(1)
    'For i = Cells(7, 14).Row To Cells(Cells(65536, 1).End(xlUp).Row, 14).Row
    For i = Res.Row To ((Res.Row + Res.Rows.Count) - 1)
        If Rows(i).Hidden = False Then 'si ligne cachée passe (j'ai juste ajouté cette condition en complément qui fait l'action de ne rien faire si cette ligne est filtré (elle ignore cette ligne comme si elle n'existait pas...) donc elle fait rien
            If Cells(i, Res.Column) Like "*" & "," & "*" Then
                T = Split(Cells(i, Res.Column), ",")
                For j = LBound(T) To UBound(T)
                    tabNb(UBound(tabNb)) = T(j)
                    ReDim Preserve tabNb(UBound(tabNb) + 1)
                Next j
            Else
                tabNb(UBound(tabNb)) = Cells(i, Res.Column)
                ReDim Preserve tabNb(UBound(tabNb) + 1)
            End If
        End If  ' Ici c'est la fin de l'instruction décrite plus haut soit If Rows(i).Hidden = False Then)
    Next i
ReDim Preserve tabNb(UBound(tabNb) - 1)
' TestDoublon
    'Cells(3, 40) = TestDoublon(tabNb)
    NbContenairesFiltré = TestDoublonFiltré(tabNb)
End Function
Function TestDoublonFiltré(ByRef tabNb() As Variant) As Double
Dim nb As Double
    For i = LBound(tabNb) To UBound(tabNb)
        For j = i + 1 To UBound(tabNb)
            If tabNb(i) = tabNb(j) Then
                tabNb(i) = ""
            End If
        Next j
    Next i
    For i = LBound(tabNb) To UBound(tabNb)
        If tabNb(i) <> "" Then
            nb = nb + 1
        End If
    Next i
TestDoublonFiltré= nb
End Function