Excel - Encontre valores exclusivos em uma coluna e valores correspondentes em outra

Question

Tenho uma exportação de banco de dados de componentes e rótulos em duas colunas. A coluna A contém um componente e a coluna B contém os rótulos associados ao componente. O mesmo componente pode aparecer várias vezes na coluna A, mas com um conjunto diferente de rótulos.

Preciso criar uma lista exclusiva de componentes na célula D e listar todos os rótulos associados na célula próxima ao componente na coluna E.

Sei como criar uma lista exclusiva de valores na coluna A, mas não sei como separar os valores se mais de um aparecer na mesma célula. Não posso alterar a forma como o banco de dados exporta esses dados.

Eu sei o suficiente sobre VBA para criar uma macro para isso, se essa for a única maneira de fazer isso. Qualquer ajuda seria apreciada.

Aqui está o que preciso fazer:

Answer 1

Você pode fazer isso criando um dicionário bidimensional. Sugeri o dicionário porque ele cuida da exclusividade. Eu escrevi uma macro que executa a tarefa (pelo menos nos seus dados de exemplo). Primeiro ele configura a estrutura de dados bidimensional e depois a imprime em ordem alfabética. Inclui uma versão simplificada de uma função de classificação que encontrei aqui:https://exceloffthegrid.com/sorting-an-array-alfabeticamente-com-vba/

Na minha macro, os dados são lidos da linha 1 ( For i = 1 To Cells(Row.Count...) até a última linha que contém os dados. Ajuste se necessário. Você também pode ter definido as letras corretas das colunas (basta pesquisar ActiveSheet.Range e você verá).

Observe que a função de classificação classifica em ordem alfabética, portanto o rótulo 11 virá antes do rótulo 2. Se isso for um problema, acho que a maneira mais rápida é criar uma segunda função de classificação para a matriz de rótulos, que converte os rótulos em números antes da comparação. Eu sei, eu sei que isso tem um desempenho terrível, mas espero que isso não importe :)

Primeiro a macro lê todas as linhas de entrada e as divide por caracteres (removendo os espaços antes - se os componentes e rótulos estiverem sempre separados por vírgula e espaço, você pode simplificar). Para cada componente cria um subdicionário, onde são armazenados os rótulos e os preenche. Se um componente ocorrer diversas vezes, o dicionário existente será atualizado. Este é o primeiro loop For principal. Se os dados estiverem configurados, ele imprime os dados classificados nas colunas D e E. Este é o segundo loop For Each principal.

Finalmente o código (eu o tenho na seção da pasta de trabalho, não no módulo de código da planilha, mas poderia funcionar lá também):

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