Excel: encuentre valores únicos en una columna y los valores correspondientes de otra

Question

Tengo una exportación de base de datos de componentes y etiquetas en dos columnas. La columna A contiene un componente y la columna B contiene las etiquetas asociadas con el componente. El mismo componente puede aparecer varias veces en la columna A pero con un conjunto diferente de etiquetas.

Necesito crear una lista única de componentes en la celda D y enumerar cada etiqueta asociada en la celda al lado del componente en la columna E.

Sé cómo crear una lista única de valores en la columna A, pero no cómo separar los valores si aparece más de uno en la misma celda. No puedo cambiar cómo la base de datos exporta estos datos.

Sé lo suficiente sobre VBA para crear una macro para esto si esa es la única forma de hacerlo. Cualquier ayuda sería apreciada.

Esto es lo que necesito hacer:

Answer 1

Puedes hacer esto creando un diccionario bidimensional. He sugerido el diccionario porque se ocupa de la unicidad. He escrito una macro que realiza la tarea (al menos con sus datos de ejemplo). Primero configura la estructura de datos bidimensional y luego la imprime ordenada alfabéticamente. Incluye una versión simplificada de una función de clasificación que encontré aquí:https://exceloffthegrid.com/sorting-an-array-alphabetically-with-vba/

En mi macro, los datos se leen desde la línea 1 ( For i = 1 To Cells(Row.Count...) hasta la última línea que contiene datos. Ajuste si es necesario. Es posible que también haya configurado las letras de columna correctas (simplemente busque ActiveSheet.Range y lo verá).

Tenga en cuenta que la función de clasificación ordena alfabéticamente, por lo que la etiqueta 11 aparecerá antes de la etiqueta 2. Si eso es un problema, creo que la forma más rápida es crear una segunda función de clasificación para la matriz de etiquetas, que convierte las etiquetas en números antes de compararlas. Lo sé, sé que esto conlleva un rendimiento terrible, pero espero que eso no importe :)

Primero, la macro lee todas las líneas de entrada y las divide por caracteres (eliminando los espacios antes; si los componentes y las etiquetas siempre están separados por comas y espacios, puede simplificar). Para cada componente crea un subdiccionario, donde se almacenan las etiquetas y las completa. Si un componente aparece varias veces, se actualiza el diccionario existente. Este es el primer bucle For principal. Si se configuran los datos, imprime los datos ordenados en las columnas D y E. Este es el segundo bucle principal For Each.

Finalmente el código (lo tengo en la sección del libro, no en el módulo de código de la hoja, pero podría funcionar allí también):

Sub CollectLabels()
    Dim spl() As String
    Dim dict
    Dim subDict
    Dim lbl As String

    ' Collect data into a 2-dimensional dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        comps = Split(Replace(ActiveSheet.Range("A" & i).Text, " ", ""), ",")
        For Each comp In comps
            If Not dict.Exists(comp) Then
                Set subDict = CreateObject("Scripting.Dictionary")
                dict.Add comp, subDict
            End If
            Labels = Split(Replace(ActiveSheet.Range("B" & i).Text, " ", ""), ",")
            For Each Label In Labels
                dict(comp)(Label) = 1
            Next Label
        Next comp
    Next i

    i = 1
    ' Output the dictionary contents
    For Each Key In SortArray(dict.Keys)
        ActiveSheet.Range("D" & i).Value = Key
        lbl = ""
        For Each Key2 In SortArray(dict(Key).Keys)
            lbl = lbl & Key2 & ", "
        Next Key2
        ActiveSheet.Range("E" & i).Value = lbl
        i = i + 1
    Next Key
End Sub

Function SortArray(arr As Variant)

Dim i As Long
Dim j As Long
Dim Temp

For i = LBound(arr) To UBound(arr) - 1
    For j = i + 1 To UBound(arr)
        If arr(i) > arr(j) Then
            Temp = arr(j)
            arr(j) = arr(i)
            arr(i) = Temp
        End If
    Next j
Next i

SortArray = arr

End Function