修改Excel VBA的Worksheet_Change事件范围并排除指定单元格

需求说明 #

现有可正常运行的Worksheet_Change事件代码，原通过Me.Range("M30:AM53")限定处理范围，现需调整为：

1. 替换为规则非连续区域：
   • 水平方向：以M31:O33为基础，按Q31:S33…的规律重复7次（每组3列，间隔1列）；
   • 垂直方向：以M31:O33为基础，按M35:O37…的规律重复6次（每组3行，间隔1行）。
2. 新增排除规则：处理时跳过目标单元格（即被修改的单元格）的上方1个单元格、下方1个单元格、右侧1个单元格。

修改后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim trlRed As Long, oPhoneBlue As Long, adrGreen As Long, iosGrey As Long, cmnPurple As Long
    Dim rng As Range, cell As Range, block As Range
    Dim horiOffset As Integer, vertOffset As Integer

    trlRed = RGB(230, 37, 30)
    oPhoneBlue = RGB(126, 199, 216)
    adrGreen = RGB(61, 220, 132)
    iosGrey = RGB(162, 170, 173)
    cmnPurple = RGB(165, 154, 202)

    'firstLvValFor = Array("TRIAL", "BEGINNER", "NOVICE", "INTERMEDIATE", "ADVANCED")
    secondLvValFor = Array("aaa", "bbb", "ccc", "ddd")

    thirdLvValFor_01 = Array("Basic", "Text", "PhoneCall", "mail", "camera")
    thirLvValFor_02 = Array("Security", "WhatsApp", "Wi-Fi")
    
    ' 构建目标非连续处理范围
    Set rng = Nothing
    ' 垂直方向循环6组：每组偏移4行（3行数据 + 1行间隔）
    For vertOffset = 0 To 5
        ' 水平方向循环7组：每组偏移4列（3列数据 + 1列间隔）
        For horiOffset = 0 To 6
            Set block = Me.Range("M31:O33").Offset(vertOffset * 4, horiOffset * 4)
            If rng Is Nothing Then
                Set rng = block
            Else
                Set rng = Union(rng, block)
            End If
        Next horiOffset
    Next vertOffset
    
    ' 仅保留Target与目标范围的交集
    Set rng = Application.Intersect(Target, rng)
    If Not rng Is Nothing Then
        For Each cell In rng.Cells
            ' 排除目标单元格的上、下、右侧单元格
            Dim excludeRng As Range
            Set excludeRng = Union(Target.Offset(-1, 0), Target.Offset(1, 0), Target.Offset(0, 1))
            If Application.Intersect(cell, excludeRng) Is Nothing Then
                ' 原颜色判断逻辑
                If cell.Value = "Session" And cell.Offset(0, -2).Value = "TRIAL" Then
                    cell.Offset(0, -2).Resize(1, 3).Interior.Color = trlRed

                ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "aaa" And cell.Offset(0, -2).Value <> "TRIAL" Then
                    cell.Offset(0, -2).Resize(1, 3).Interior.Color = oPhoneBlue

                ElseIf cell.Value = "aaa" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                    cell.Offset(0, -1).Resize(1, 3).Interior.Color = oPhoneBlue

                ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "bbb" And cell.Offset(0, -2).Value <> "TRIAL" Then
                    cell.Offset(0, -2).Resize(1, 3).Interior.Color = adrGreen

                ElseIf cell.Value = "bbb" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                    cell.Offset(0, -1).Resize(1, 3).Interior.Color = adrGreen

                ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "ccc" And cell.Offset(0, -2).Value <> "TRIAL" Then
                    cell.Offset(0, -2).Resize(1, 3).Interior.Color = iosGrey

                ElseIf cell.Value = "ccc" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                    cell.Offset(0, -1).Resize(1, 3).Interior.Color = iosGrey

                ElseIf IsError(Application.Match(cell.Value, thirLvValFor_02, 0)) = False And cell.Offset(0, -1).Value = "ddd" And cell.Offset(0, -2).Value <> "TRIAL" Then
                    cell.Offset(0, -2).Resize(1, 3).Interior.Color = cmnPurple

                ElseIf cell.Value = "ddd" And IsError(Application.Match(cell.Offset(0, 1).Value, thirLvValFor_02, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                    cell.Offset(0, -1).Resize(1, 3).Interior.Color = cmnPurple

                Else
                    cell.Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        Next cell
    End If
End Sub

关键修改说明 #

1. 非连续范围构建：
   通过双层循环生成所有目标区块：垂直方向循环6次（每次偏移4行，对应3行数据+1行间隔），水平方向循环7次（每次偏移4列，对应3列数据+1列间隔），使用Union方法将所有区块合并为一个完整的处理范围。
2. 排除规则实现：
   在遍历每个单元格前，先创建包含Target上、下、右侧单元格的排除范围，若当前单元格属于该范围则跳过处理，满足锁定需求。
3. 原逻辑保留：
   原有颜色判断逻辑完全保留，仅调整范围限定和新增排除规则，确保原有功能不受影响。

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