Перенести значения из столбца в одну ячеку

[manivoki]

Здравствуйте! Возникла проблема, уже всю голову поломала, помогите, пожалуйста. Есть столбец с повторяющимися группами строк, напротив значения, нужно эти значения напротив для каждой группы повторяющихся строк перенести в одну ячейку, через запятую или др. знак препинания. Количество строк в каждой группе разное. И документ объемный, вручную никак (( Если посмотреть пример, то все понятно будет.
Пример в файле.

[cheshiki1]

Код Выделить Развернуть

Function VLOOKUPCOUPLE_spec(Table As Variant, SearchColumnNum1 As Integer, SearchValue As Variant, _
                       RezultColumnNum As Integer, Separator_ As String)
'Table - таблица, где ищем
'SearchColumnNum - номер столбеца, где ищем
'SearchValue - данные, которые ищем
'RezultColumnNum - номер колонки, откуда берём результат
'Separator_ - разделитель, желательно вводить с пробелом в конце

    Dim i As Long
    Select Case TypeName(Table)
    Case "Range"
        For i = 1 To Table.Rows.Count
            If Table.Cells(i, SearchColumnNum1) = SearchValue Then
                If VLOOKUPCOUPLE_spec <> "" Then
                    VLOOKUPCOUPLE_spec = VLOOKUPCOUPLE_spec & Separator_ & Table.Cells(i, RezultColumnNum)
                Else
                    VLOOKUPCOUPLE_spec = Table.Cells(i, RezultColumnNum)
                End If
            End If
        Next i
    Case "Variant()"
        For i = 1 To UBound(Table)
            If Table.Cells(i, SearchColumnNum1) = SearchValue Then
                If VLOOKUPCOUPLE_spec <> "" Then
                    VLOOKUPCOUPLE_spec = VLOOKUPCOUPLE_spec & Separator_ & Table(i, RezultColumnNum)
                Else
                    VLOOKUPCOUPLE_spec = Table(i, RezultColumnNum)
                End If
            End If
        Next i
    End Select
    If VLOOKUPCOUPLE_spec = 0 Then VLOOKUPCOUPLE_spec = ""
End Function

формула в ячейке

Код Выделить Развернуть

=VLOOKUPCOUPLE_spec($A$2:$B$16;1;A2;2;",")

[manivoki]

Большое спасибо! Разобралась )))

[Hugo121]

Зачем же  мою VLOOKUPCOUPLE_spec() корёжили, это ведь была спецверсия для поиска по двум столбцам (кому-то нужно было именно по двум искать) - теперь ищущих по этому названию будет с толку сбивать...
Есть ведь оригинал:

Код Выделить Развернуть


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

Тут ещё и повторы убираются, или их можно оставить, если нужны.
На листе в ячейку

Код Выделить Развернуть

=VLOOKUPCOUPLE($A$2:$B$16;1;A2;2;",")
последний параметр можно не указывать, если повторы нужно убрать.

[manivoki]

Всем большое спасибо, очень выручили! Полезный ресурс!

[manivoki]

Здравствуйте, снова нужна помощь!

Зачем же  мою VLOOKUPCOUPLE_spec() корёжили, это ведь была спецверсия для поиска по двум столбцам (кому-то нужно было именно по двум искать) - теперь ищущих по этому названию будет с толку сбивать...

Наверное мне теперь нужна именно эта функция.
Имеется три столбца: артикул, размер и цвет. Мне надо чтобы искало по артикулу, сравнивало размеры и у разных размеров напротив выводило их цвета. На примере думаю будет понятно, прилагаю.