Страницы: 1
RSS
функция VLOOKUPCOUPLE (из копилки идей)
 
Добрый день!  
 
У меня вопрос - можно ли усовершенствовать функцию VLOOKUPCOUPLE (выложена в копилке)?  
Проблема в следующем - если в колонке, откуда берем результат, встречаются несколько одинаковых значений, соответствующих данным, которые ищем, то все они попадают в сцепку. Можно ли изменить функцию так, чтобы в сцепку попадали только уникальные значения, т.е. без повторов?  
 
файл прикрепляю.  
 
Спасибо.
 
Уже была такая тема - я там сказал, что неплохо бы в копилку код добавить - но как-то не заметили.  
А теперь уже и тема потерялась...  
Вот очередная версия (у меня проходит как VLOOKUPCOUPLE6 :)) - спасибо The_Prist и RAN:  
 
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, 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 = ""  
   VLOOKUPCOUPLE = vlk  
End Function  
 
 
А вообще - СЦЕПИТЬЕСЛИ() Дмитрия повторы фильтрует с рождения.
 
файл
 
Спасибо, HUGO! Просто ОГОНЬ))
 
Кстати, как и первый вариант - работает и с закрытыми книгами.  
Только в таком случае нельзя указывать как диапазон полные столбцы.  
Если книга открыта - можно.  
И кстати для случая полных столбцов - лучше заменить строку  
If TypeName(Table) = "Range" Then Table = Table.Value  
на  
If TypeName(Table) = "Range" Then Table = Intersect(Table.Parent.UsedRange, Table).Value
Страницы: 1
Читают тему
Наверх