如何用Excel VBA遍历分组的两列并生成辅助列标识组内异同

实现代码 #

Sub CheckDivisionConsistency()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim groupDict As Object
    Dim i As Long
    Dim currentGroup As String
    Dim currentDiv As String
    
    ' 指定目标工作表，按需修改表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取A列数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典存储分组与对应部门ID的关系
    Set groupDict = CreateObject("Scripting.Dictionary")
    
    ' 第一遍遍历：收集每个分组的唯一部门ID
    For i = 2 To lastRow ' 假设第1行为表头，从第2行开始处理数据
        currentGroup = ws.Cells(i, "A").Value
        currentDiv = ws.Cells(i, "B").Value
        
        If Not groupDict.Exists(currentGroup) Then
            groupDict.Add currentGroup, CreateObject("Scripting.Dictionary")
        End If
        ' 利用字典去重特性，记录该分组下出现的部门ID
        groupDict(currentGroup)(currentDiv) = True
    Next i
    
    ' 第二遍遍历：根据唯一部门ID数量填充结果
    For i = 2 To lastRow
        currentGroup = ws.Cells(i, "A").Value
        If groupDict(currentGroup).Count = 1 Then
            ws.Cells(i, "C").Value = "SAME"
        Else
            ws.Cells(i, "C").Value = "MIXED"
        End If
    Next i
    
    ' 释放对象
    Set groupDict = Nothing
    Set ws = Nothing
    
    MsgBox "处理完成！"
End Sub

代码说明 #

• 借助**字典（Dictionary）**的去重特性，高效统计每个分组下的唯一部门ID数量，避免嵌套循环的低效问题
• 分两次遍历：第一次收集分组的部门ID信息，第二次批量填充结果列
• 若你的数据表头不在第1行，只需修改代码中For i = 2 To lastRow的起始行数值
• 可通过修改ThisWorkbook.Worksheets("Sheet1")切换目标工作表

使用步骤 #

1. 打开目标Excel文件
2. 按下Alt + F11打开VBA编辑器
3. 右键点击工程窗口中的工作簿名称 → 插入 → 模块
4. 将上述代码粘贴到模块中
5. 按下F5运行代码，或点击编辑器工具栏的运行按钮

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