Как извлечь из столбца 2 и более значения

[Евгений Таб]

Добрый день!
Насколько я знаю ВПР возвращает только одно (и кстати только первое) значения из диапазона. А если критерия 2, то но вернет только первое.
Как реализовать (формула/VBA) процесс вывода всех найденных критериев, к примеру через запятую.
Во вложении примерный файл, я думаю тут нужно ввести новую формулу через VBA. Подскажите.

Cпасибо.

[Hugo121]

=VLOOKUPCOUPLE($A$3:$B$26,1,G3,2,", ")

поищите код UDF тут на форуме - я когда-то публиковал.

[Евгений Таб]

Сообщение от Hugo121

=VLOOKUPCOUPLE($A$3:$B$26,1,G3,2,", ")

поищите код UDF тут на форуме - я когда-то публиковал.

не понимаю о чем идет речь, поясните пжслст

[Hugo121]

Плохо ищется, не нашёл на форуме...

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

Поясняю - это код функции пользователя - его в стандартный модуль (лучше надстройки, или этого файла, но можно и в Personal'ьную книгу).
Применять на листе как обычную функцию, выбрать в разделе "Определённые пользователем".
P.S. И Вы же сами просили "новую формулу через VBA" - вот это оно и есть. И иначе в общем случае никак и не сделать (стандартными формулами трудно, на 1000 повторов не написать).

[IgorGO]

я написал функцию Груши:

Function Grushi(N)
  Dim c As Range
  Grushi = ""
  For Each c In Cells(WorksheetFunction.Match(N, [a:a], 0), 1).Resize(WorksheetFunction.CountIf([a:a], N), 1).Offset(0, 1)
    If Not IsEmpty(c) Then Grushi = Grushi & "," & c
  Next
  If Grushi <> "" Then Grushi = Right(Grushi, Len(Grushi) - 1)
End Function

во вложении пример ее использования.

[Евгений Таб]

Разобрался, сделал надстройку, пришил ее, но вбить верные данные не могу, проверьте вашу формули во втором посте, с ней чтото не так

[Евгений Таб]

Сообщение от IgorGO

я написал функцию Груши:

Function Grushi(N)
  Dim c As Range
  Grushi = ""
  For Each c In Cells(WorksheetFunction.Match(N, [a:a], 0), 1).Resize(WorksheetFunction.CountIf([a:a], N), 1).Offset(0, 1)
    If Not IsEmpty(c) Then Grushi = Grushi & "," & c
  Next
  If Grushi <> "" Then Grushi = Right(Grushi, Len(Grushi) - 1)
End Function

во вложении пример ее использования.

интересное решение, буду думать как свои данные прикрутить

[Hugo121]

Вероятно у нас разные разделители. Я свои показал - Вы нет
Если формулу заводить мастером - разделители роли не играют.
Кстати, результат получается точно как у Вас в файле.