прошу помочь с решением, использую СцепитьЕсли , но по какой-то причине в некоторых случаях подтягиваются не все значения по заданному критерию. В VBA не соображаю, макрос нашел на данном ресурсе. Может у кого-то была подобная проблема? Как возможно решить?
Файл с примером прилагаю.
Заранее благодарю.
Добрый день,
прошу помочь с решением, использую СцепитьЕсли , но по какой-то причине в некоторых случаях подтягиваются не все значения по заданному критерию. В 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] Правда этот код на Маках работать не будет. И иногда если в Винде остутствует словарь - то и на Винде не взлетит. А предыдущий тянул не всё потому что там логика очевидно писалась под конкретную задачу...
Посоветую использовать такую UDF:
Код
=VLOOKUPCOUPLE(Данные!A:B;1;A2;2;"+")
Код: [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] Правда этот код на Маках работать не будет. И иногда если в Винде остутствует словарь - то и на Винде не взлетит. А предыдущий тянул не всё потому что там логика очевидно писалась под конкретную задачу...Hugo
Небольшое дополнение, немного поработал с данной функцией, обнаружил, что если для одного критерия в таблице с данными существует два одинаковых значения, то данное значение подтягивается только один раз. Если кто-нибудь сможет подправить, буду очень благодарен.
Небольшое дополнение, немного поработал с данной функцией, обнаружил, что если для одного критерия в таблице с данными существует два одинаковых значения, то данное значение подтягивается только один раз. Если кто-нибудь сможет подправить, буду очень благодарен.ВасяСемячкин