如何创建唯一列表？答案

【问题标题】：How to Create Unique Lists?如何创建唯一列表？
【发布时间】：2021-10-20 12:36:23
【问题描述】：

我一直在尝试获取电子邮件列表，然后查找这些电子邮件所附的所有可能相关的电子邮件。例如，我可能有一个如下所示的列表：

SME	Backup	Comp	A1	A2
Person A	Person B	Person C	Person D	Person E
Person A	Person B	Person F	Person G
Person A	Person B	Person F	Person H

我想把它变成这样：

SME	CONTACTS
Person A	Person B; Person C; Person D; Person E; Person F; Person G; Person H

基本上，获取与该特定 SME 相关的个人的唯一列表。当然，我的实际数据中有多个SME，所以我需要循环这个。

【问题讨论】：

标签： excel vba excel-formula pivot-table excel-2016

【解决方案1】：

使用Dictionary Objects

Option Explicit

Sub macro1()

    Dim wb As Workbook
    Dim wsIn As Worksheet, wsOut As Worksheet, cell As Range
    Dim dict As Object, key, SME As String, r As Long, c As Long
    Dim ar As Variant

    Set wb = ThisWorkbook
    Set wsIn = wb.Sheets("Sheet1")
    Set wsOut = wb.Sheets("Sheet2")

    Set dict = CreateObject("Scripting.Dictionary")

    ' put data into array
    ar = wsIn.UsedRange.Value2

    ' input
    For r = 2 To UBound(ar) '2 - avoid hedaer
        SME = Trim(ar(r, 1))
        For c = 1 To UBound(ar, 2)
            If Len(ar(r, c)) > 0 Then
                If c = 1 Then
                    If Not dict.exists(SME) Then
                        Set dict(SME) = CreateObject("Scripting.Dictionary")
                    End If
                Else
                    dict(SME)(ar(r, c)) = 1
                End If
            End If
        Next
    Next

    ' output
    With wsOut
        .Cells.Clear
        .Range("A1:B1") = Array("SME", "CONTACTS")
        .Range("A1:B1").Font.Bold = True
        Set cell = .Range("A2")
    End With
    For Each key In dict.keys
        cell = key
        cell.Offset(0, 1) = Join(dict(key).keys, "; ")
        Set cell = cell.Offset(1, 0)
    Next
    wsOut.Activate
    wsOut.Range("A1").Select
    MsgBox dict.Count & " SMEs written to " & wsOut.Name, vbInformation

End Sub

【讨论】：

【解决方案2】：

如果您确实需要 VBA 来执行此操作，请查看 https://www.youtube.com/watch?v=6LOsQFipqkw

您也可以使用 Power Query 来完成：

将表加载到 Power Query 中
选择除第一列之外的所有列
取消透视列
删除不必要的列
删除重复行
关闭并加载

【讨论】：