如何优化含多个非连续区域的Excel VBA工作表双击事件代码

我有一张供项目经理（PM）配置大型系统的工作表，分为四个面板区域。每个面板中，PM需要从Fluid Type的4个选项、Control Type的2个选项中各选一项（示例可选列为E、G、I、K）：

• 面板1：
  • Fluid Type选项：E9、G9、I9、K9
  • Control Type选项：E10、G10
• 面板2：
  • Fluid Type选项：E21、G21、I21、K21
  • Control Type选项：E22、G22
• 面板3、4结构与上述一致，仅所在行位置不同。

现有一段VBA代码可实现需求：双击某个选项单元格时，该单元格变为蓝色，同组的其他选项单元格恢复无填充色。请问能否简化这段代码？

原代码：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim r1a As Range
    Dim r1b As Range
    Dim r2a As Range
    Dim r2b As Range
    Dim r3a As Range
    Dim r3b As Range
    Dim r4a As Range
    Dim r4b As Range
        Set r1a = Range("E9, G9, I9, K9")
        Set r1b = Range("E10,G10")
        Set r2a = Range("E21, G21, I21, K21")
        Set r2b = Range("E22,G22")
        Set r3a = Range("E32, G32, I32, K32")
        Set r3b = Range("E33,G33")
        Set r4a = Range("E43, G43, I43, K43")
        Set r4b = Range("E44,G44")
        r1a.Name = "P1FT"
        r1b.Name = "P1CT"
        r2a.Name = "P2FT"
        r2b.Name = "P2CT"
        r3a.Name = "P3FT"
        r3b.Name = "P3CT"
        r4a.Name = "P4FT"
        r4b.Name = "P4CT"
    If Not Intersect(Target, Range("P1FT")) Is Nothing Then
        Range("P1FT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P1CT")) Is Nothing Then
        Range("P1CT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P2FT")) Is Nothing Then
        Range("P2FT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P2CT")) Is Nothing Then
        Range("P2CT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P3FT")) Is Nothing Then
        Range("P3FT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P3CT")) Is Nothing Then
        Range("P3CT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P4FT")) Is Nothing Then
        Range("P4FT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    ElseIf Not Intersect(Target, Range("P4CT")) Is Nothing Then
        Range("P4CT").Interior.ColorIndex = xlNone
        Target.Interior.Color = RGB(0, 176, 240) 'blue
    End If
End Sub

简化后的代码方案 #

方案1：用数组存储区域组，循环处理

直接把所有需要控制的区域放进数组，通过循环匹配目标单元格，消除重复的判断和命名逻辑：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' 定义所有同类型的选项区域组
    Dim groups As Variant
    groups = Array( _
        Range("E9,G9,I9,K9"), Range("E10,G10"), _
        Range("E21,G21,I21,K21"), Range("E22,G22"), _
        Range("E32,G32,I32,K32"), Range("E33,G33"), _
        Range("E43,G43,I43,K43"), Range("E44,G44") _
    )
    
    Dim group As Range
    ' 遍历每个区域组，检查目标是否在组内
    For Each group In groups
        If Not Intersect(Target, group) Is Nothing Then
            group.Interior.ColorIndex = xlNone ' 清除组内所有填充
            Target.Interior.Color = RGB(0, 176, 240) ' 高亮目标单元格
            Exit For ' 找到匹配组后直接退出，提升效率
        End If
    Next group
End Sub

方案2：动态生成区域（扩展性更强）

如果后续可能调整面板数量或位置，可通过面板起始行动态计算区域，避免硬编码所有单元格地址：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Const BLUE_COLOR As Long = RGB(0, 176, 240)
    ' 四个面板的起始行
    Dim panelStarts As Variant
    panelStarts = Array(9, 21, 32, 43)
    
    Dim startRow As Long
    Dim ftRange As Range, ctRange As Range
    
    ' 遍历每个面板，动态生成对应区域
    For Each startRow In panelStarts
        Set ftRange = Range("E" & startRow & ",G" & startRow & ",I" & startRow & ",K" & startRow)
        Set ctRange = Range("E" & startRow + 1 & ",G" & startRow + 1)
        
        ' 匹配Fluid Type区域
        If Not Intersect(Target, ftRange) Is Nothing Then
            ftRange.Interior.ColorIndex = xlNone
            Target.Interior.Color = BLUE_COLOR
            Exit Sub
        End If
        ' 匹配Control Type区域
        If Not Intersect(Target, ctRange) Is Nothing Then
            ctRange.Interior.ColorIndex = xlNone
            Target.Interior.Color = BLUE_COLOR
            Exit Sub
        End If
    Next startRow
End Sub

简化说明 #

1. 消除重复代码：两种方案都替代了原代码中大量独立的变量定义、区域命名和重复判断块，代码量减少一半以上。
2. 提升可维护性：后续新增面板或调整区域时，只需修改数组内容（方案1）或起始行数组（方案2）即可，无需改动核心逻辑。
3. 效率优化：找到匹配区域后立即退出循环，避免不必要的遍历。

内容的提问来源于Stack Exchange，提问作者Yodelayheewho