多工作表（超100个）三列公共单元格高亮问题求助

针对你需要对比Sheet1与100+工作表A/B/C列、高亮公共单元格的需求，原VBA无响应的核心问题是逐单元格循环的低效遍历和未禁用Excel的实时刷新机制。以下是优化后的解决方案：

核心优化思路 #

• 用Dictionary存储Sheet1的所有目标单元格值，将O(n)的查找复杂度降至O(1)
• 批量读取工作表数据到数组，减少Excel对象模型的交互次数（这是VBA提速的关键）
• 禁用屏幕更新、事件触发和自动计算，避免运行时的资源浪费
• 统一处理Sheet1内的重复项和跨工作表的公共项

优化后的VBA代码 #

Sub HighlightCommonCells()
    Dim wsMaster As Worksheet
    Dim ws As Worksheet
    Dim masterData As Variant
    Dim cellDict As Object
    Dim i As Long, j As Long
    Dim cellValue As Variant
    Dim dataArr As Variant
    
    ' 初始化字典（启用后期绑定，无需引用库）
    Set cellDict = CreateObject("Scripting.Dictionary")
    Set wsMaster = ThisWorkbook.Worksheets("Sheet1")
    
    ' 关闭Excel耗时功能
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 读取Sheet1的A-C列数据到数组
    masterData = wsMaster.Range("A1:C" & wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row).Value
    
    ' 将Sheet1的所有单元格值存入字典（键为值，值为出现次数）
    For i = LBound(masterData, 1) To UBound(masterData, 1)
        For j = LBound(masterData, 2) To UBound(masterData, 2)
            cellValue = masterData(i, j)
            If Not IsEmpty(cellValue) Then
                If cellDict.Exists(cellValue) Then
                    cellDict(cellValue) = cellDict(cellValue) + 1
                Else
                    cellDict(cellValue) = 1
                End If
            End If
        Next j
    Next i
    
    ' 处理Sheet1内的重复项（出现次数>1的单元格）
    For i = LBound(masterData, 1) To UBound(masterData, 1)
        For j = LBound(masterData, 2) To UBound(masterData, 2)
            cellValue = masterData(i, j)
            If Not IsEmpty(cellValue) And cellDict(cellValue) > 1 Then
                wsMaster.Cells(i, j).Interior.Color = RGB(255, 255, 153) ' 浅黄色高亮
            End If
        Next j
    Next i
    
    ' 遍历其他所有工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsMaster.Name Then
            ' 读取当前工作表A-C列数据到数组
            dataArr = ws.Range("A1:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value
            
            ' 批量检查并高亮公共单元格
            For i = LBound(dataArr, 1) To UBound(dataArr, 1)
                For j = LBound(dataArr, 2) To UBound(dataArr, 2)
                    cellValue = dataArr(i, j)
                    If Not IsEmpty(cellValue) And cellDict.Exists(cellValue) Then
                        ws.Cells(i, j).Interior.Color = RGB(255, 255, 153)
                    End If
                Next j
            Next i
        End If
    Next ws
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "高亮完成！", vbInformation
End Sub

关键说明 #

1. 字典的作用：将Sheet1的所有值提前存入字典，后续查找只需O(1)时间，避免了原代码中多次遍历Sheet1的低效操作
2. 数组批量处理：直接将整列数据读入内存数组，比逐个访问单元格快10-100倍，尤其适合100+工作表的场景
3. 禁用耗时功能：ScreenUpdating关闭后不会实时刷新界面，EnableEvents避免触发不必要的工作表事件，Calculation改为手动防止自动计算拖慢速度
4. 高亮颜色：代码中使用浅黄色（RGB(255,255,153)），可根据需求修改RGB值

使用注意事项 #

• 确保Sheet1的名称正确，若你的主表名称不同，修改代码中Set wsMaster = ThisWorkbook.Worksheets("Sheet1")的工作表名
• 启用宏：文件需保存为.xlsm格式，打开时启用宏
• 若数据量极大（单工作表超过10万行），可进一步拆分数据块处理，但当前代码已能应对绝大多数场景

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