Excel 计算列中的唯一数据，然后将其与另一个唯一数据进行匹配

这是一个令人尴尬的简单问题，但我几个小时都没能找到一种方法来解决它，也没能从在线搜索中找到一个想法

假设我有以下数据，Excel表1中的实际数据可能是数千或数百万：

Name    No. ID
A       A1
B       B4
B       B5
C       C0
D       -
A       A1
A       A2
E       -
F       -
C       C0
B       B5
B       B5
B       B5
B       B6
A       A1
A       A1
A       A2
B       B3
B       B3
B       B3

上面第ID列中的字符也可以是数字0或空白单元格

我想将上述数据格式化为表2

Name    Number of ID
A       2
B       4
C       1
D       0
E       0
F       0

这意味着A有2个ID A1和A2，B有4个ID B1、B2、B3和B4，C有1个ID C0，D、E和F没有ID

使用Pivot表可以得到的最好结果如下

---

如何在MS Excel中执行类似表2的任务？如果可能，请使用VBA脚本。

将列a复制到另一个未使用的列，并执行一次数据备份► “删除重复项”命令，然后对其进行排序。很少有公式能有效地处理数千行数据，也没有公式能处理数百万行数据

对其旁边的B列执行相同的操作。不要扩展删除重复项所要求的选择

接下来，在刚创建的A列数据的未复制集旁边的列中使用以下公式：

=COUNTIF(F:F, E2&"*")

填写到未重复数据的范围。我假设您使用列E创建第一个未复制的数据集，使用列F创建第二个

---

将列A复制到另一个未使用的列，并执行数据复制► “删除重复项”命令，然后对其进行排序。很少有公式能有效地处理数千行数据，也没有公式能处理数百万行数据

对其旁边的B列执行相同的操作。不要扩展删除重复项所要求的选择

接下来，在刚创建的A列数据的未复制集旁边的列中使用以下公式：

=COUNTIF(F:F, E2&"*")

填写到未重复数据的范围。我假设您使用列E创建第一个未复制的数据集，使用列F创建第二个

---

如果有人对上述问题的VBA解决方案感兴趣：

Sub GetUniquesCount()
    Dim dict1 As Object, dict2 As Object
    Dim c1 As Variant, c2 As Variant
    Dim i As Long, lastRow As Long, count As Long

    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")

    lastRow = Cells(Rows.count, "A").End(xlUp).Row
    c1 = Range("A2:A" & lastRow)
    For i = 1 To UBound(c1, 1)
        dict1(c1(i, 1)) = 1
    Next i
    Range("D2").Resize(dict1.count) = Application.Transpose(dict1.keys)

    lastRow = Cells(Rows.count, "B").End(xlUp).Row
    c2 = Range("B2:B" & lastRow)
    For i = 1 To UBound(c2, 1)
        dict2(c2(i, 1)) = 1
    Next i

    For Each cel In Range("D2:D" & Cells(Rows.count, "D").End(xlUp).Row)
        count = 0
        For Each k2 In dict2.keys
            If k2 Like cel.Value & "*" Then
                count = count + 1
            End If
        Next k2
        cel.Offset(0, 1).Value = count
    Next cel
End Sub

---

如果有人对上述问题的VBA解决方案感兴趣：

Sub GetUniquesCount()
    Dim dict1 As Object, dict2 As Object
    Dim c1 As Variant, c2 As Variant
    Dim i As Long, lastRow As Long, count As Long

    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")

    lastRow = Cells(Rows.count, "A").End(xlUp).Row
    c1 = Range("A2:A" & lastRow)
    For i = 1 To UBound(c1, 1)
        dict1(c1(i, 1)) = 1
    Next i
    Range("D2").Resize(dict1.count) = Application.Transpose(dict1.keys)

    lastRow = Cells(Rows.count, "B").End(xlUp).Row
    c2 = Range("B2:B" & lastRow)
    For i = 1 To UBound(c2, 1)
        dict2(c2(i, 1)) = 1
    Next i

    For Each cel In Range("D2:D" & Cells(Rows.count, "D").End(xlUp).Row)
        count = 0
        For Each k2 In dict2.keys
            If k2 Like cel.Value & "*" Then
                count = count + 1
            End If
        Next k2
        cel.Offset(0, 1).Value = count
    Next cel
End Sub

---

谢谢你的回答真的很有帮助。你能给我一个VBA脚本来执行这个任务吗？但是等等，我想发布另一个问题来执行几乎相同的任务。等等+无论如何，谢谢。你的回答真的很有帮助。你能给我一个VBA脚本来执行这个任务吗？但是等等，我想发布另一个问题来执行几乎相同的任务。等等+1无论如何。。。