Здравствуйте, новичек в ВБА, нашел код который ведет циклический поиск значения. Нужно как-то после того как значение найдено, вывести как результат строку из n столбцов которая находится справа от него. И так для всех значений (например "максим")
[vba]
Код
Sub www() With Worksheets(1).Range("A1:A50") Set c = .Find("максим", LookIn:=xlValues) If Not c Is Nothing Then firstResult = c.Address Do [c1] = c
Set c = .Find("максим", After:=c, LookIn:=xlValues) Loop While Not c Is Nothing And c.Address <> firstResult End If End With End Sub
[/vba]
Здравствуйте, новичек в ВБА, нашел код который ведет циклический поиск значения. Нужно как-то после того как значение найдено, вывести как результат строку из n столбцов которая находится справа от него. И так для всех значений (например "максим")
[vba]
Код
Sub www() With Worksheets(1).Range("A1:A50") Set c = .Find("максим", LookIn:=xlValues) If Not c Is Nothing Then firstResult = c.Address Do [c1] = c
Set c = .Find("максим", After:=c, LookIn:=xlValues) Loop While Not c Is Nothing And c.Address <> firstResult End If End With End Sub
Нашел решение, уже написана функция UDF для этой цели, если кому понадобится: [vba]
Код
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
[/vba]
Вставить в "модуль" и использовать функцию =VLOOKUPCOUPLE(A:B;1;A1;2;",";0)
Вытянуть в ячейки по горизонтали по разделителю "|" [vba]
Нашел решение, уже написана функция UDF для этой цели, если кому понадобится: [vba]
Код
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
[/vba]
Вставить в "модуль" и использовать функцию =VLOOKUPCOUPLE(A:B;1;A1;2;",";0)
Вытянуть в ячейки по горизонтали по разделителю "|" [vba]