如何简化具有多个不连续范围的代码

Question

我有一个项目经理 (PM) 用于配置大型系统的工作表。该工作表有四个部分，分别代表四个面板。在每个面板中，PM 必须选择流体类型的四个选项之一和控制类型的两个选项之一。对于本示例，E、G、I 和 K 是要选择的列。 面板1 流体类型选项 E、G、I、K（第 9 行） 控制类型选项 E、G（第 10 行） 面板2 流体类型选项 E、G、I、K（第 21 行） 控制类型选项 E、G（第 22 行） 面板 3 和 4 是相同的，但当然是不同的行。

下面的代码效果很好。如果我单击 E9，单元格会变成蓝色，并且 G9、I9 和 K9 没有填充颜色。如果我然后点击 I9，那么它会变成蓝色，E9、G9 和 K9 没有填充颜色等。 有没有办法简化这段代码？

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

Answer 1

无需为范围命名即可访问它。可以直接写

Set r1a = Range("E9, G9, I9, K9")
If Not Intersect(Target, r1a) Is Nothing Then
    r1a.Interior.ColorIndex = xlNone
    Target.Interior.Color = RGB(0, 176, 240) 'blue
End If

但是当您在所有 8 个范围上执行相同的操作时，我会创建一个处理一个范围的小例程并调用该例程 8 次。

您的代码可以简单地如下所示：

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
    MarkSelectedCellInRange target, Range("E9, G9, I9, K9")
    MarkSelectedCellInRange target, Range("E10, G10")
    MarkSelectedCellInRange target, Range("E21, G21, I21, K21")
    MarkSelectedCellInRange target, Range("E22, G22")
    MarkSelectedCellInRange target, Range("E32, G32, I32, K32")
    MarkSelectedCellInRange target, Range("E33, G33")
    MarkSelectedCellInRange target, Range("E43, G43, I43, K43")
    MarkSelectedCellInRange target, Range("E44, G44")
End Sub

Sub MarkSelectedCellInRange(selectedCell As Range, panel As Range)
    If Intersect(selectedCell, panel) Is Nothing Then Exit Sub    ' No hit
    panel.Interior.ColorIndex = xlNone
    selectedCell.Interior.Color = RGB(0, 176, 240) 'blue
End Sub