如何用VBA统计Excel中与第一列关联的第二列唯一值数量？

我懂你要的需求——针对每个ID，统计对应的ID2列里的唯一值个数对吧？找了一圈没找到适配方案，那直接给你两个实用的VBA实现，拿来就能用：

方案1：批量生成所有ID的统计结果 #

这个宏会自动遍历你的数据，处理完后在工作表里直接输出每个ID对应的唯一ID2数量，适合一次性处理整个数据集：

Sub CountUniqueID2PerID()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim idDict As Object
    Dim id2Dict As Object
    Dim i As Long
    Dim currentID As String
    Dim currentID2 As String
    Dim outputRow As Long
    
    ' 替换成你的目标工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 用双层字典存ID和对应的唯一ID2集合
    Set idDict = CreateObject("Scripting.Dictionary")
    
    ' 从第2行开始遍历（跳过表头）
    For i = 2 To lastRow
        currentID = ws.Cells(i, "A").Value
        currentID2 = ws.Cells(i, "B").Value
        
        ' 首次遇到该ID时，创建子字典存它的ID2
        If Not idDict.Exists(currentID) Then
            Set id2Dict = CreateObject("Scripting.Dictionary")
            idDict.Add currentID, id2Dict
        End If
        
        ' 把ID2加入子字典（字典自动去重，重复值不会被二次添加）
        Set id2Dict = idDict(currentID)
        If Not id2Dict.Exists(currentID2) Then
            id2Dict.Add currentID2, 1
        End If
    Next i
    
    ' 在C、D列输出统计结果
    outputRow = 2
    ws.Cells(1, "C").Value = "ID"
    ws.Cells(1, "D").Value = "唯一ID2数量"
    
    For Each currentID In idDict.Keys
        ws.Cells(outputRow, "C").Value = currentID
        ' 子字典的键的数量就是唯一值个数
        ws.Cells(outputRow, "D").Value = idDict(currentID).Count
        outputRow = outputRow + 1
    Next currentID
    
    MsgBox "统计完成！结果已输出到C、D列", vbInformation
End Sub

使用说明： #

1. 打开你的Excel文件，按Alt+F11打开VBA编辑器
2. 插入一个新模块，把上面的代码粘贴进去
3. 把代码里的Sheet1改成你实际的工作表名称
4. 运行这个宏，等待完成后就能看到结果了

方案2：自定义函数，灵活调用 #

如果你想在单元格里直接计算某个ID的唯一ID2数量，用这个自定义函数更方便：

Function CountUniqueID2(targetID As String, idRange As Range, id2Range As Range) As Long
    Dim idDict As Object
    Dim i As Long
    Dim currentID As String
    Dim currentID2 As String
    
    Set idDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历指定的ID和ID2范围
    For i = 1 To idRange.Cells.Count
        currentID = idRange.Cells(i).Value
        currentID2 = id2Range.Cells(i).Value
        
        ' 只处理和目标ID匹配的行
        If currentID = targetID Then
            If Not idDict.Exists(currentID2) Then
                idDict.Add currentID2, 1
            End If
        End If
    Next i
    
    ' 返回唯一值的数量
    CountUniqueID2 = idDict.Count
End Function

使用说明： #

1. 同样在VBA编辑器里插入模块，粘贴代码
2. 返回工作表，在任意单元格输入公式：
   • 比如要统计SS_ID 1的唯一ID2数量：=CountUniqueID2("SS_ID 1", A:A, B:B)
   • 或者直接引用单元格：=CountUniqueID2(A2, A:A, B:B)，下拉就能批量计算每一行对应的ID的统计结果

小提示： #

如果你的数据里ID或ID2有多余的空格，会被当成不同的值，你可以在代码里给currentID和currentID2加上Trim()函数，比如currentID = Trim(ws.Cells(i, "A").Value)，这样就能自动去除首尾空格了。

内容的提问来源于stack exchange，提问作者David Morocutti