Function NbUnique&(ByVal RgSuj As Range, _
Optional ByVal RgÀInv1 As Range, Optional ByVal Val1 = "Oui", _
Optional ByVal RgÀInv2 As Range, Optional ByVal Val2 = "Oui")
Dim LDéb&, TSuj(), TÀInv1(), TÀInv2(), L&
With RgSuj.Worksheet.UsedRange
Set RgSuj = RgSuj.Resize(.Row + .Rows.Count - RgSuj.Row): End With
TSuj = RgSuj.Value
With New Scripting.Dictionary ' Implique référence "Microsoft Scripting Runtime"
If RgÀInv1 Is Nothing Then
For L = 1 To UBound(TSuj)
If Not IsEmpty(TSuj(L, 1)) Then .Item(TSuj(L, 1)) = Empty
Next L
ElseIf RgÀInv2 Is Nothing Then
TÀInv1 = Intersect(RgÀInv1.EntireColumn, RgSuj.EntireRow).Value
For L = 1 To UBound(TSuj)
If Not IsEmpty(TSuj(L, 1)) And TÀInv1(L, 1) = Valeur1 Then .Item(TSuj(L, 1)) = Empty
Next L:
Else
TÀInv1 = Intersect(RgÀInv1.EntireColumn, RgSuj.EntireRow).Value
TÀInv1 = Intersect(RgÀInv2.EntireColumn, RgSuj.EntireRow).Value
For L = 1 To UBound(TSuj)
If Not IsEmpty(TSuj(L, 1)) And TÀInv1(L, 1) = Val1 _
And TÀInv2(L, 1) = Val2 Then .Item(TSuj(L, 1)) = Empty
Next L: End If
NbUnique = .Count: End With
End Function