☰

fusionar celdas con fórmula omitir duplicados

tag-icon • tag-icon microsoft-excel worksheet-function
fusionar celdas con fórmula omitir duplicados

Nuestro objetivo es fusionar los nombres (B) cuando los datos en A son iguales. La siguiente fórmula mira la siguiente línea (A), si es la misma, fusiona datos (nombre) de B. La fórmula está en C, por lo que el resultado de los nombres combinados aparecerá en C. =IF(A2<>A3,B2, B2&" , "&B3)

Ejemplo:si A2:XYZ y A3:XYZ entoncesfusionar B2:Samy B3:Danen C = "Sam, Dan".

Problema: Necesitamos mostrar todos los nombres fusionados en una celda (C) que tengan una A coincidente, omitiendo los duplicados.

Si A1:A4 = XYZ, yB1:Sam B2=Dan B3=Dan B4=Joe`Entonceslos resultados en C deberían decir "Sam, Dan, Joe"

Cualquier sugerencia sera apreciada.

Respuesta1

Este VBA ordenará de forma ascendente, eliminará duplicados y le proporcionará una lista de resultados.

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

información relacionada