求助：Excel VBA批量检查A/B/C列同项对应F列求和着色问题

我来帮你搞定这个VBA代码的问题，先拆解下原代码里的几个核心问题，再给你调整后的完整可用代码：

原代码的主要问题 #

• 判断逻辑混乱：检查单元格是否在A/B/C列的写法错误，而且没有把同一行的A、B、C值关联起来作为分组依据
• 求和逻辑错误：没有按照A/B/C相同的行来分组求和，只是错误地引用了单个单元格的F列值
• 事件处理缺失：没有关闭EnableEvents，修改单元格颜色时会反复触发Worksheet_Change事件，导致递归报错
• 循环范围不合理：遍历Target的方式没法覆盖所有需要检查的行，尤其是批量粘贴数据的场景

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim checkRange As Range
    Dim cell As Range
    Dim dataDict As Object
    Dim key As String
    Dim sumVal As Double
    Dim rowNum As Variant
    
    ' 定义需要检查的范围：A5:C5000和F5:F5000
    Set checkRange = Me.Range("A5:C5000,F5:F5000")
    ' 如果修改的区域不在检查范围内，直接退出
    If Application.Intersect(Target, checkRange) Is Nothing Then Exit Sub
    
    ' 关闭事件触发，避免修改颜色时递归触发本事件
    Application.EnableEvents = False
    
    ' 创建字典用于分组存储A/B/C组合对应的行和总和
    Set dataDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历所有需要检查的行（A5到A5000）
    For Each cell In Me.Range("A5:A5000")
        ' 如果A/B/C任意单元格为空，跳过该行
        If cell.Value <> "" And cell.Offset(0, 1).Value <> "" And cell.Offset(0, 2).Value <> "" Then
            ' 把A/B/C的值拼接成字典的键
            key = cell.Value & "|" & cell.Offset(0, 1).Value & "|" & cell.Offset(0, 2).Value
            
            If Not dataDict.Exists(key) Then
                ' 键不存在时，初始化总和和行号集合
                dataDict(key) = Array(0, New Collection)
            End If
            
            ' 累加F列的值
            sumVal = dataDict(key)(0) + cell.Offset(0, 5).Value
            ' 把当前行号加入集合
            dataDict(key)(1).Add cell.Row
            ' 更新字典里的总和
            dataDict(key) = Array(sumVal, dataDict(key)(1))
        End If
    Next cell
    
    ' 遍历字典，根据总和设置F列颜色
    For Each key In dataDict.Keys
        sumVal = dataDict(key)(0)
        ' 遍历该分组下的所有行号
        For Each rowNum In dataDict(key)(1)
            If sumVal > 100 Then
                ' 总和超过100，设置红色背景
                Me.Range("F" & rowNum).Interior.Color = RGB(255, 0, 0)
            Else
                ' 总和不超过，恢复白色背景
                Me.Range("F" & rowNum).Interior.Color = RGB(255, 255, 255)
            End If
        Next rowNum
    Next key
    
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

代码逻辑说明 #

1. 范围检查：先判断修改的单元格是否在我们需要关注的A5:C5000或F5:F5000范围内，不在的话直接退出，提升效率
2. 字典分组：用Scripting.Dictionary把A、B、C列值完全相同的行归为一组，键是A|B|C的拼接字符串，值存储该组的F列总和和对应的行号
3. 求和处理：遍历所有行，计算每个分组的F列总和
4. 颜色设置：根据每个分组的总和是否超过100，批量设置对应行F列的背景色
5. 事件防护：修改单元格颜色时会触发Worksheet_Change，所以先关闭EnableEvents，操作完成后再恢复，避免递归报错

使用注意事项 #

• 把这段代码粘贴到对应的工作表模块里（不是标准模块），比如你要处理的是Sheet1，就右键Sheet1选择「查看代码」，然后粘贴进去
• 不管是单个修改单元格还是批量粘贴数据，代码都会自动触发检查并更新颜色

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