Количество уникальных значений по условию

Public Enum MTD
    [КОЛИЧЕСТВО_УНИ] = 0
    [МАССИВ_УНИ] = 1
End Enum
Public Function СВОД_УСЛ(Диапазон As Range, Условие As Variant, _
     Диапазон_условия As Range, metod As MTD)
Dim IC As Range
Dim RC As Range
Dim icv As Variant
Dim rcv As Variant
Dim x As Long
Dim y As Long
Dim USL() As Variant
Dim SHT As Boolean
Application.Volatile
x = Диапазон.Row + Диапазон.Rows.Count - 1
y = Диапазон.Parent.UsedRange.Rows.Count
If x > y Then x = y - Диапазон.Row + 1
Set Диапазон = Range(Диапазон.Cells(1), Диапазон.Rows(x).Cells(1))
Set Диапазон_условия = Диапазон.Offset(0, Диапазон_условия.Column - Диапазон.Column)
 
ReDim USL(1 To 1)
For Each IC In Диапазон_условия
    icv = IC.Value
    If LCase(icv) = LCase(Условие) Then
        For Each RC In Диапазон
            rcv = RC.Value
            If rcv <> "" And rcv <> 0 Then
                If RC.Row = IC.Row Then
                    SHT = True
                    For x = 1 To UBound(USL)
                        If USL(x) = rcv Then
                            SHT = False
                        End If
                    Next
                    If SHT Then
                        USL(UBound(USL)) = rcv
                        ReDim Preserve USL(1 To UBound(USL) + 1)
                    End If
                End If
            End If
        Next
    End If
Next
ReDim Preserve USL(1 To UBound(USL) - 1)
Select Case metod
    Case КОЛИЧЕСТВО_УНИ
    СВОД_УСЛ = UBound(USL)
    Case МАССИВ_УНИ
    СВОД_УСЛ = USL()
End Select
End Function

Function uniqdogcountbyindex(rind, ind As String, rdog)
    Dim i As Long
    rind = Intersect(rind.Parent.UsedRange, rind).Value
    rdog = Intersect(rdog.Parent.UsedRange, rdog).Value
    On Error Resume Next
    With New Collection
        For i = 1 To UBound(rind)
            If rind(i, 1) = ind Then .Add rdog(i, 1), Trim(rdog(i, 1))
        Next
        uniqdogcountbyindex = .Count
    End With
    On Error GoTo 0
End Function

=uniqdogcountbyindex(Таблица!B:B;A2;Таблица!C:C)

Sub Данные()
    Dim i As Long, N As Long, c As Collection, m As Long
    Dim j As Long, vd As String, va As String
 
    Columns("C:C").Copy Range("L1")
 
    ActiveSheet.Range("L:L").RemoveDuplicates Columns:=1, Header:=xlYes
 
    Range("L1").Value = "Данные"
 
    N = Cells(Rows.Count, "L").End(xlUp).Row
    m = Cells(Rows.Count, "A").End(xlUp).Row
 
    For i = 2 To N
        Set c = Nothing
        Set c = New Collection
        vd = Cells(i, "L").Value
        For j = 2 To m
            va = Cells(j, "C").Value
            If va = vd Then
                On Error Resume Next
                    c.Add Cells(j, "A").Value, CStr(Cells(j, "A").Value)
                On Error GoTo 0
            End If
        Next j
        Cells(i, "M").Value = c.Count
    Next i
End Sub