Question

I have a worksheet that project managers (PM) use to configure large systems. The worksheet has four sections that represent each of four panels. Within each panel, the PM must select one of the four options for Fluid Type and one of the two options for Control Type. For this example, E, G, I and K are the columns to select. Panel 1 Fluid Type Options E, G, I, K (row 9) Control Type Options E, G (row 10) Panel 2 Fluid Type Options E, G, I, K (row 21) Control Type Options E, G (row 22) Panel 3 & 4 are the same, but different rows of course.

The following code works great. If I click on E9 the cell turns blue AND G9, I9 and K9 have no fill color. If I then click on I9, then it turns blue and E9, G9 and K9 have no fill color, etc. Is there a way to streamline this code?

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

无需给出一系列名字才能查阅。页: 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

But as you are doing the same stuff on all of your 8 ranges, I would create a small routine that handles one range and call that routine 8 times.

Your code can then simply look like this:

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

Answer 2

A Worksheet BeforeDoubleClick: Highlight Single Cell of Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim RangeAddresses() As Variant: RangeAddresses = VBA.Array( _
        "E9,G9,I9,K9", "E10,G10", "E21,G21,I21,K21", "E22,G22", _
        "E32,G32,I32,K32", "E33,G33", "E43,G43,I43,K43", "E44,G44")
    Dim ColorNumber As Long: ColorNumber = RGB(0, 176, 240)  blue
        
    Dim n As Long
    
    For n = 0 To UBound(RangeAddresses)
        With Me.Range(RangeAddresses(n))
            If Not Intersect(Target, .Cells) Is Nothing Then
                .Interior.ColorIndex = xlNone
                Target.Interior.Color = ColorNumber
                Cancel = True
                Exit For
            End If
        End With
    Next n
                
End Sub

A Worksheet BeforeDoubleClick: Highlight Single Cell of Range

友情链接