Function СЦЕПИТЬЕСЛИМН(rngU As Range, ParamArray Conditions()) As String
'rngU - диапазон сцепления
'Conditions() - массив ПАР значений вида: Диапазон_Условий1;Условие1;Диапазон_Условий2;Условие2...Диапазон_УсловийN;УсловиеN, обязательный
'               должен иметь хотя-бы одну пару значений.
'Разделителем найденных уникальных значений является ', ' (запятая с пробелом)
'Все диапазоны должны состоять из одного столбца и иметь равное кол-во строк
Dim cl()
Dim arrFlag() As Boolean
Dim I&, j&
On Error Resume Next
cl = rngU.Value
For I = 1 To UBound(cl)
    ReDim arrFlag(Int(UBound(Conditions) / 2))
    For j = LBound(Conditions) To UBound(Conditions) Step 2
        If rngU.Parent.Cells(rngU(I).Row, Conditions(j).Column).Value Like Conditions(j + 1) Then
            arrFlag(Int(j / 2)) = True
        End If
      If БезПовторов Then
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary")
        sTmpStr = Split(sStr, разделитель)
        On Error Resume Next
        For li = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(li), sTmpStr(li)
        Next li
        sStr = ""
        sTmpStr = oDict.Keys
        For li = LBound(sTmpStr) To UBound(sTmpStr)
            sStr = sStr & IIf(sStr <> "", разделитель, "") & sTmpStr(li)
        Next li
    End If
        
    Next
    If WorksheetFunction.And(arrFlag) = True Then
         
        
        If СЦЕПИТЬЕСЛИМН <> Empty Then
            СЦЕПИТЬЕСЛИМН = СЦЕПИТЬЕСЛИМН & " " & cl(I, 1)
        Else
            СЦЕПИТЬЕСЛИМН = cl(I, 1)
        End If
  
    
    End If
    
Next
End Function