Option Explicit
Function СцепитьМассивЕсли(Table As Variant, SearchColumnNum As Integer, SearchValue As Variant, _
                         RezultColumnNum As Integer, Separator_ As String, Optional BezPovtorov As Boolean = True)
'Table - таблица, где ищем
'SearchColumnNum - столбец, где ищем
'SearchValue - данные, которые ищем
'RezultColumnNum - колонка, откуда берём результат
'Separator_ - разделитель, желательно вводить с пробелом в конце
'BezPovtorov - если поставить 0, то будут выведены все повторяющиеся совпадения

     Dim i As Long, oDict As Object, tmp As String, vlk
          
     If TypeName(Table) = "Range" Then Table = Table.Value

     If BezPovtorov Then
         Set oDict = CreateObject("Scripting.Dictionary")

         For i = 1 To UBound(Table)
             If Table(i, SearchColumnNum) = SearchValue Then
                 tmp = Table(i, RezultColumnNum)
                 If tmp <> "" Then
                     If Not oDict.Exists(tmp) Then
                         oDict.Add tmp, 0&
                         vlk = vlk & Separator_ & Table(i, RezultColumnNum)
                     End If
                 End If
             End If
         Next i

     Else
         For i = 1 To UBound(Table)
             If Table(i, SearchColumnNum) = SearchValue Then
                 vlk = vlk & Separator_ & Table(i, RezultColumnNum)
             End If
         Next i
     End If
     If vlk > 0 Then vlk = Mid(vlk, Len(Separator_) + 1) Else vlk = ""
     СцепитьМассивЕсли = vlk
End Function

Function VLOOKUPCOUPLE(Table As Variant, _
                        SearchColumnNum As Integer, _
                        SearchValue As Variant, _
                        RezultColumnNum As Integer, _
                        Separator_ As String, _
                        Optional BezPovtorov As Boolean = True)

'Table - таблица, где ищем
'SearchColumnNum - столбец, где ищем
'SearchValue - данные, которые ищем
'RezultColumnNum - столбец, откуда берём результат
'Separator_ - разделитель, желательно вводить с пробелом в конце
'BezPovtorov - если поставить 0, то будут выведены все повторяющиеся совпадения

     Dim i As Long, tmp As String, vlk

     If TypeName(Table) = "Range" Then Table = Intersect(Table.Parent.UsedRange, Table).Value
     If BezPovtorov Then
         With CreateObject("Scripting.Dictionary")
             For i = 1 To UBound(Table)
                 If Table(i, SearchColumnNum) = SearchValue Then
                     tmp = Table(i, RezultColumnNum)
                     If tmp <> "" Then
                         If Not .Exists(tmp) Then
                             .Add tmp, 0&
                             vlk = vlk & Separator_ & Table(i, RezultColumnNum)
                         End If
                     End If
                 End If
             Next i
         End With
     Else
         For i = 1 To UBound(Table)
             If Table(i, SearchColumnNum) = SearchValue Then
                 vlk = vlk & Separator_ & Table(i, RezultColumnNum)
             End If
         Next i
     End If
     If vlk > 0 Then vlk = Mid(vlk, Len(Separator_) + 1) Else vlk = ""
     VLOOKUPCOUPLE = vlk
End Function