Excel VBA实现单元格值动态变色及错误代码13排查

错误原因分析 #

错误代码13是类型不匹配，常见触发场景：

• 批量操作时，部分单元格包含错误值（如#N/A）或非文本值，直接和字符串"Session"比较会触发类型冲突
• 事件重入：修改单元格颜色会再次触发Worksheet_Change事件，导致逻辑混乱
• 极端边界单元格操作时，偏移可能超出工作表范围（虽然代码已限定目标区域，但仍需防护）

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim trlRed As Long, adrBlue As Long
    Dim targetRange As Range, cell As Range
    Dim colorRange As Range
    
    ' 定义配色
    trlRed = RGB(230, 37, 30)
    adrBlue = RGB(126, 199, 216)
    
    ' 限定操作范围为M31:AM53
    Set targetRange = Intersect(Target, Me.Range("M31:AM53"))
    If targetRange Is Nothing Then Exit Sub
    
    ' 关闭事件触发，避免修改颜色时重复触发Change事件
    Application.EnableEvents = False
    
    On Error Resume Next ' 捕获类型不匹配、越界等错误
    For Each cell In targetRange.Cells
        ' 确定要修改颜色的3列区域，防止偏移越界
        Set colorRange = Nothing
        If cell.Column >= 3 Then
            Set colorRange = cell.Offset(0, -2).Resize(1, 3)
        End If
        If colorRange Is Nothing Then Set colorRange = cell.Resize(1, 3)
        
        ' 先清空原有颜色，删除课程时自动恢复默认格式
        colorRange.Interior.ColorIndex = xlColorIndexNone
        
        ' 仅处理文本类型的单元格值，避免类型不匹配
        If VarType(cell.Value) = vbString Then
            Select Case cell.Value
                Case "Session"
                    If cell.Offset(0, -2).Value = "Trial" Then
                        colorRange.Interior.Color = trlRed
                    End If
                Case "AndroidSmartphone"
                    ' 统一大小写判断，避免因输入大小写不一致失效
                    If UCase(cell.Offset(0, -1).Value) <> "TRIAL" Then
                        colorRange.Interior.Color = adrBlue
                    End If
            End Select
        End If
    Next cell
    On Error GoTo 0 ' 恢复默认错误处理
    
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

关键优化点 #

• 事件重入防护：操作前关闭Application.EnableEvents，防止修改颜色时重复触发事件导致逻辑循环
• 类型安全校验：仅对文本类型的单元格值做判断，避免非文本值（如错误值、数值）引发类型不匹配错误
• 越界防护：提前检查偏移后的单元格有效性，避免边界操作报错
• 批量操作兼容：遍历选中区域内的每个单元格，不管是单个还是批量输入/删除，都能正确处理
• 删除自动恢复：每次处理前先清空对应3列区域的颜色，删除课程值时会自动恢复无填充格式

使用说明 #

1. 替换原有Worksheet_Change事件代码即可
2. 批量输入：选中多个单元格输入课程后回车，对应3列区域自动变色
3. 批量删除：选中任意区域按Delete，对应区域的格式自动恢复默认

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