Function VLOOKUPCOUPLE2(Table As Variant, SearchColumnNum As Integer, SearchValue As Variant, _ RezultColumnNum As Integer, Separator_ As String) 'Table - таблица, где ищем 'SearchColumnNum - столбец, где ищем 'SearchValue - данные, которые ищем 'RezultColumnNum - колонка, откуда берём результат 'Separator_ - разделитель, желательно вводить с пробелом в конце
Dim i As Long
If TypeName(Table) = "Range" Then Table = Intersect(Table.Parent.UsedRange, Table).Value For i = 1 To UBound(Table) If Table(i, SearchColumnNum) Like SearchValue Then If VLOOKUPCOUPLE2 <> "" Then VLOOKUPCOUPLE2 = VLOOKUPCOUPLE2 & Separator_ & Table(i, RezultColumnNum) Else VLOOKUPCOUPLE2 = Table(i, RezultColumnNum) End If End If Next i If VLOOKUPCOUPLE2 = 0 Then VLOOKUPCOUPLE2 = "" End Function
[/vba]
А можно такой UDF:
Код
=VLOOKUPCOUPLE2(A:A,1,"*",1,",")
[vba]
Код
Function VLOOKUPCOUPLE2(Table As Variant, SearchColumnNum As Integer, SearchValue As Variant, _ RezultColumnNum As Integer, Separator_ As String) 'Table - таблица, где ищем 'SearchColumnNum - столбец, где ищем 'SearchValue - данные, которые ищем 'RezultColumnNum - колонка, откуда берём результат 'Separator_ - разделитель, желательно вводить с пробелом в конце
Dim i As Long
If TypeName(Table) = "Range" Then Table = Intersect(Table.Parent.UsedRange, Table).Value For i = 1 To UBound(Table) If Table(i, SearchColumnNum) Like SearchValue Then If VLOOKUPCOUPLE2 <> "" Then VLOOKUPCOUPLE2 = VLOOKUPCOUPLE2 & Separator_ & Table(i, RezultColumnNum) Else VLOOKUPCOUPLE2 = Table(i, RezultColumnNum) End If End If Next i If VLOOKUPCOUPLE2 = 0 Then VLOOKUPCOUPLE2 = "" End Function