Function СЧЁТУНИКЕСЛИМН(rngU As Range, ParamArray Conditions()) As Long
'rngU - диапазон отбора уникальных значений, обязательный
'ПАРЫ аргументов: диапазон_условий1;условие1;диапазон_условий2;условие2...диапазон_условийN;условиеN
'обязательна хотя-бы одна пара
Dim cl As Range
Dim arrFlag() As Boolean
Dim I As Long
On Error Resume Next
With New Collection
    For Each cl In rngU
        ReDim arrFlag(Int(UBound(Conditions) / 2))
        For I = LBound(Conditions) To UBound(Conditions) Step 2
            If Cells(cl.Row, Conditions(I).Column).Value Like Conditions(I + 1) Then
                arrFlag(Int(I / 2)) = True
            End If
        Next
        If WorksheetFunction.And(arrFlag) = True Then
            .Add cl, CStr(cl)
            If Err = 0 Then
                СЧЁТУНИКЕСЛИМН = СЧЁТУНИКЕСЛИМН + 1
            Else
                Err.Clear
            End If
        End If
    Next
End With
End Function