Function MergeIf(TextRange As Range, SearchRange As Range, Condition As String)
    Dim Delimeter As String, i As Long
    Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
     
    'если диапазоны проверки и склеивания не равны друг другу - выходим с ошибкой
    If SearchRange.Count <> TextRange.Count Then
        MergeIf = CVErr(xlErrRef)
        Exit Function
    End If
     
    'проходим по все ячейкам, проверяем условие и собираем текст в переменную OutText
    For i = 1 To SearchRange.Cells.Count
        If SearchRange.Cells(i) Like Condition Then OutText = OutText & TextRange.Cells(i) & Delimeter
    Next i
     
    'выводим результаты без последнего разделителя
    MergeIf = Left(OutText, Len(OutText) - Len(Delimeter))
End Function

Function VLOOKUP3(Table As Range, SearchColumnNum As Integer, _
                  SearchValue As Variant, ResultColumnNum As Integer)
'улучшенная функция ВПР вводится как формула массива
'ищет указанной значение в указанном столбце и выводит все соответствия из указанного столбца
    Dim i&, j&
    Dim a
    ReDim Out(1 To Table.Rows.Count, 1 To 1) As Variant

    a = Table.Value
    For i = 1 To Table.Rows.Count
        If a(i, SearchColumnNum) = SearchValue Then
            j = j + 1
            Out(j, 1) = a(i, ResultColumnNum)
        End If
    Next i
    VLOOKUP3 = Out
End Function