объединить ячейки с формулой пропустить дубликаты

Question

Наша цель - объединить имена (B), когда данные в A равны. Формула ниже смотрит на следующую строку (A), если она такая же, она объединяет данные (имя) из B. Формула находится в C, поэтому результат объединенных имен будет отображаться в C. =IF(A2<>A3,B2, B2&" , "&B3)

Пример: если A2:XYZ и A3:XYZ тогда объедините B2:Sam и B3:Dan в C = "Sam, Dan" .

Проблема: Нам нужно отобразить все имена, объединенные в одну ячейку (C), которые имеют совпадающую A, пропуская дубликаты.

Если A1:A4 = XYZ, и B1: Сэм B2 = Дэн B3 = Дан B4 = Джо`, тогда результаты в C должны выглядеть так: «Сэм, Дэн, Джо»

Мы ценим любые предложения.

Answer 1

Этот VBA будет сортировать по возрастанию, удалять дубликаты и выводить список результатов.

Sub test()
Application.ScreenUpdating = False
' Sort Ascending
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:B")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Remove Duplicates
    ActiveSheet.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo

'concatenate
Dim data, numrows As Long, result, i As Long, n As Long


If Range("a1") = "" Then Exit Sub

With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)

    .Sort key1:=Range("a1"), Header:=xlNo
    data = .Value
    numrows = UBound(data)
    ReDim result(1 To numrows, 1 To 1)


    For i = 1 To numrows

    temp = data(i, 1)
    result(i, 1) = result(i, 1) & data(i, 2)

    For n = i + 1 To numrows

        If data(n, 1) = temp Then result(i, 1) = result(i, 1) & ", " & data(n, 2) Else Exit For

    Next

    i = n - 1

    Next

    .Offset(, 2).resize(,1) = result

    End With

    Application.ScreenUpdating = True


End Sub