如何在选择更改时切换单元格颜色

Question

我的单元格引用范围为（D6:D33）。在此单元格区域中，如果我选择D10，则其背景色应变为红色。如果再次选择相同的单元格D10，则其背景色应更改为以前的颜色。 同样，它应适用于D6:D33范围内选择的任何单元格。我该如何修改下面的不完整代码来做到这一点？

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("D6:D33")) Is Nothing Then
           Range("D10").Interior.Color = RGB(255, 55, 55)
        End If
    End If
End Sub

Answer 1

本色

闪耀版本（ADV）

打开工作簿时，所有颜色均写入数组。如果选择是区域中的单元格，则更改选择时，颜色将变为红色，而先前的颜色将被写入数组。当颜色为红色时，将应用数组中的前一种颜色，并将红色写入数组等。

修复了2007年及更高版本（CountLarge）的溢出错误。修复了“无颜色白色错误”。

要指出各种错误，请向BigBen致谢。

Module1 ：

Option Explicit

Public vnt1 As Variant
Public Const cRng As String = "D6:D33"
Public Const cColor As Long = 255

此工作簿：

Option Explicit

Private Sub Workbook_Open()

  Dim i As Long

  With Range(cRng)
    ReDim vnt1(1 To .Rows.Count, 1 To 1) As Long
    For i = 1 To .Rows.Count
      With .Cells(i, 1).Interior
        If .ColorIndex <> xlNone Then
          vnt1(i, 1) = .Color
         Else
          vnt1(i, 1) = -1
        End If
      End With
    Next
  End With

  ' For i = 1 To UBound(vnt1)
  '   Debug.Print i & "  " & vnt1(i, 1)
  ' Next

End Sub

Sheet1 ：

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  Dim lngDiff As Long
  Dim lngTemp As Long

  If Val(Application.Version) >= 12 Then
    If Selection.Cells.CountLarge > 1 Then Exit Sub
   Else
    If Selection.Cells.Count > 1 Then Exit Sub
  End If

  lngDiff = Range(cRng).Row - 1

  If Not Intersect(Target, Range(cRng)) Is Nothing Then
    With Target.Interior
      If .Color <> cColor Then
        If .ColorIndex <> xlNone Then
          lngTemp = .Color
         Else
          lngTemp = -1
        End If
        vnt1(.Parent.Row - lngDiff, 1) = lngTemp
        .Color = cColor
       Else
        If vnt1(.Parent.Row - lngDiff, 1) <> -1 Then
          .Color = vnt1(.Parent.Row - lngDiff, 1)
         Else
          .ColorIndex = xlNone
        End If
        vnt1(.Parent.Row - lngDiff, 1) = cColor
      End If
    End With
  End If

End Sub

红色和白色版本（INT）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  If Val(Application.Version) >= 12 Then
    If Selection.Cells.CountLarge > 1 Then Exit Sub
   Else
    If Selection.Cells.Count > 1 Then Exit Sub
  End If

  If Not Intersect(Target, Range("D6:D33")) Is Nothing Then
    If Target.Interior.Color <> RGB(255, 0, 0) Then
      Target.Interior.Color = RGB(255, 0, 0)
     Else
      Target.Interior.Color = RGB(255, 255, 255)
    End If
  End If

End Sub

Answer 2

在模块中

from django.urls import reverse

在工作表代码中

Public vColor(6 To 33)
Sub setColor()
    Dim rng As Range
    Dim n As Integer
    n = 6
    For Each rng In Range("d6:d33")
        vColor(n) = rng.Interior.Color
        n = n + 1
    Next rng
End Sub

Answer 3

您只能保留Dictionary个点击的单元格：

Option Explicit

Dim colorsDict As Scripting.Dictionary

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("D6:D33")) Is Nothing Then
            If colorsDict Is Nothing Then Set colorsDict = New Scripting.Dictionary ' instantiate a dictionary object
            With colorsDict ' reference dictionary object
                If .Exists(Target.Address) Then ' if selected cell already in dictionary (i.e. already selected)
                    Target.Interior.Color = .Item(Target.Address) ' get its "original" color back
                    .Remove Target.Address ' remove its address from dictionary (i.e. as if it was never selected before) 
                Else ' if selected cell not in dictionary (i.e. not already selected)
                    .Add Target.Address, IIf(Target.Interior.Color = 16777215, xlNone, Target.Interior.Color) ' keep track of its original color storing it into dictionary with cell target as key
                    Target.Interior.Color = RGB(255, 55, 55) ' color the selected cell with red
                End If
            End With
        End If
    End If
End Sub