Public Function Уникальные_по_критерию(диапазон As Range, Optional type_info& = 0)
Dim i&, mas() As String
Dim dic As Object, arrDicKeys(), n&
Set dic = CreateObject("Scripting.Dictionary")
n = Application.Caller.Cells.Count
ReDim mas(1 To диаппазон.Count, 1 To 1)
For Each C In диаппазон
        i = i + 1
        mas(i, 1) = C
Next
'Добавление уникальных в словарь
     For i = 1 To UBound(mas)
       If Not dic.Exists(mas(i, 1)) And Not Trim(mas(i, 1)) = "" Then dic.Add mas(i, 1), i
     Next i
      If type_info = 0 Then Уникальные_по_критерию = dic.Count: Exit Function
      arrDicKeys = dic.keys '   перегон в массив
     ReDim mas(1 To n, 1 To 1)
         
     If n > UBound(arrDicKeys) + 1 Then n = UBound(arrDicKeys) + 1
     For i = 1 To n: mas(i, 1) = arrDicKeys(i - 1): Next i
      Уникальные_по_критерию = mas
End Function