EXCEL: нажмите на одну ячейку и выделите другую - PullRequest
Новая
       20

EXCEL: нажмите на одну ячейку и выделите другую

0 голосов
/ 12 января 2020 
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Sheets("test")
     .Cells.Interior.ColorIndex = xlColorIndexNone
       Select Case Target.Address
        Case "$D$3" 
         .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$3" 
         .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$3" 
         .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

ASK Этот код очень большой и новый.

Можно редактировать этот код " Кейс" $ D $ 3 "" как Кейс "$ D $ 3:" $ J $ 3: "$ V $ 3" ​​ - не работает

А это: .Range ("D3"). Interior.Color = RGB (195, 195, 195 )

Как и D3: J3: P3 - плохо работает

Ответы [ 2 ]

0 голосов
/ 12 января 2020

Вот код с небольшим изменением синтаксиса:

Используйте Пересечь функцию для проверки и 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

0 голосов
/ 12 января 2020

Попробуйте этот код.

Прочитайте комментарии внутри кода и настройте его в соответствии с вашими потребностями: 

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
...