EXCEL：单击一个单元格并突出显示另一个单元格

Question

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Sheets("test")
     .Cells.Interior.ColorIndex = xlColorIndexNone
       Select Case Target.Address
        Case "$D" 
         .Range("D3").Interior.Color = RGB(195, 195, 195)
         .Range("J3").Interior.Color = RGB(195, 195, 195)
         .Range("V3").Interior.Color = RGB(195, 195, 195)
         Case "$J" 
         .Range("D3").Interior.Color = RGB(195, 195, 195)
         .Range("J3").Interior.Color = RGB(195, 195, 195)
         .Range("V3").Interior.Color = RGB(195, 195, 195)
         Case "$V" 
         .Range("D3").Interior.Color = RGB(195, 195, 195)
         .Range("J3").Interior.Color = RGB(195, 195, 195)
         .Range("V3").Interior.Color = RGB(195, 195, 195)


        End Select
    End With
End Sub

询问这段代码很大，菜鸟。

可以像 Case "$D$3:"$J$3:"$V$3" 一样编辑此代码" Case "$D$3"" =24=] - 它不起作用

还有这个：.Range("D3").Interior.Color = RGB(195, 195, 195)

喜欢 D3:J3:P3 - 效果不佳

Answer 1

试试这个代码。

阅读代码中的注释并根据您的需要进行调整：

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim evalRange As Range
    Dim highlightRange As Range

    ' Set the ranges addresses like this:
    '   if cells are contigous use ":" e.g. D3:E5 would evaluate D3, D4, D5, E3, E4 and E5
    '   if cells are non contigous use "," to separate each cell
    Set evalRange = Me.Range("D3,J3,V3")
    Set highlightRange = Me.Range("D3,J3,V3")

    ' This next line will remove the background of all the cells in the current sheet
    ' You can use "Me" to refer to the current sheet
    Me.UsedRange.Cells.Interior.ColorIndex = xlColorIndexNone

    ' We check if the Target which is the cell or cells selected intersects with the evaluated range defined at the beginning
    If Not Intersect(Target, evalRange) Is Nothing Then
        ' If it does, then we set the background color to all cells in the highlight range defined at the beginning
        highlightRange.Interior.Color = RGB(195, 195, 195)
    End If

End Sub

Answer 2

这是为您提供的语法稍有改动的代码：

使用 Intersect 函数进行检查，IIF 用于 Toogle

    Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim isIntersect As Range
        Dim Listrange As Variant
        Listrange = Array("D3, J3, V3","D5, J4, V8")
        'Listrange = Array("D3, J3, V3","D5, J4, V8","....") ex:add another range
        Dim i As Integer
        For i = 0 To UBound(Listrange)
        With Range(Listrange(i))
            Set isIntersect = Intersect(Target, .Cells)
            .Interior.Color = IIf(isIntersect Is Nothing, xlNone, RGB(195, 195, 195))
        End With

        Next i
    End Sub

注意：可以用RGB(255, 195, 255)或16777215代替xlNone

EXCEL：单击一个单元格并突出显示另一个单元格

EXCEL: Click One Cell and Highlight Another

excel

highlight

cell