Encontre relacionamentos entre itens em uma lista do Excel

Question

Eu tenho uma lista do Excel que se parece com isso:

Project  ID
ABC      Al
ABC      Bob
ABC      Chad
DEF      Bob
DEF      Dick

Estou tentando encontrar uma função para que eu possa ter apenas os links entre os IDs. A lista final ficaria assim:

Al Bob
Al Chad
Bob Chad
Bob Dick

Em outras palavras, você pode ver a partir da entrada que as pessoas Al, Bob e Dick trabalharam no projeto ABC. Nos meus dados, isso significa que eles têm um relacionamento (ou seja, eles trabalharam no mesmo projeto). Assim, gostaria de ter uma linha por relacionamento.

    

Answer 1

Aqui está uma solução VBA. Você só precisa selecionar suas duas colunas de dados (não selecione os cabeçalhos) e, em seguida, executar Partners .

Sub Partners()
Dim tmpColl As Collection, Projects As Object, v() As Variant, tmp As Variant
Dim s As Worksheet, k As Variant
Set Projects = CreateObject("scripting.dictionary")
Set tmpColl = New Collection
v = Selection.Value
'Use project as a dictionary key. Each key is paired with a collection of the IDs for that project.
For i = LBound(v, 1) To UBound(v, 1)
    If Projects.Exists(v(i, 1)) Then
        Set tmpColl = Projects.Item(v(i, 1))
        tmpColl.Add v(i, 2)
        Projects.Remove v(i, 1)
        Projects.Add v(i, 1), tmpColl
    Else
        Set tmpColl = New Collection
        tmpColl.Add v(i, 2)
        Projects.Add v(i, 1), tmpColl
    End If
Next i
'Create output sheet.
Set s = ThisWorkbook.Worksheets.Add
s.Name = "Output"
s.Range("A1") = "ID1"
s.Range("B1") = "ID2"
For Each k In Projects.Keys
    tmp = ListPairs(Projects.Item(k))
    s.UsedRange.Offset(s.UsedRange.Rows.Count, 0).Resize(UBound(tmp, 1), 2).Value = tmp
Next k
End Sub

Function ListPairs(C As Collection) As Variant
Dim v() As Variant, idx As Long
'Returns each pair combination from collection of items.
idx = 1
If C.Count > 1 Then
    ReDim v(1 To C.Count * (C.Count - 1) / 2, 1 To 2) As Variant
    For i = 1 To C.Count - 1
        For j = i + 1 To C.Count
            v(idx, 1) = C.Item(i)
            v(idx, 2) = C.Item(j)
            idx = idx + 1
        Next j
    Next i
End If
ListPairs = v
End Function

Este código gerará as combinações em uma nova planilha chamada "Saída". Se houver uma folha existente com este nome, haverá um erro. Neste caso, você pode editar a linha

s.Name = "Output"

para alterar o nome da folha de saída.