Question

我在Excel中有一个包含日期的表。表格的记录链接到日历（在另一张表格上），这样，如果您点击表格中的日期，您将被带到日历中该日期的单元格。在我的日历表上，我有以下VBA，它将该表的活动单元格的填充颜色更改为黄色。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim cell As Range
    'Turn off ScreenUpdating (speeds up code)
    Application.ScreenUpdating = False
    'Loop through each cell in the ActiveSheet
    For Each cell In ActiveSheet.UsedRange
        'Check for a specific fill color
        If cell.Interior.Color = RGB(255, 255, 0) Then
            'Remove Fill Color
            cell.Interior.Color = xlNone
        End If
    Next cell
    ' Highlight the active cell
    Target.Interior.ColorIndex = 6
    Application.ScreenUpdating = True
End Sub

如果用户激活日历表上的另一个单元格，该单元格最初包含填充颜色，则会清除该单元格的原始颜色。

我希望通过此代码更改工作表上的单元格从填充颜色X（紫色，在我的情况下）到无填充颜色，而是保留用户设置的填充颜色X.

我基本上需要在Excel中填充颜色图层。

Answer 1

请检查一下（我使用2个范围（a2，a3）保存以前可以选择的情况：

 Option Explicit




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim cell As Range
    Dim i As String
    Dim i1 As Long

    On Error Resume Next

    i = Range("a3").Value
    i1 = Range("a2").Value


'Turn off ScreenUpdating (speeds up code)
  Application.ScreenUpdating = False

'Loop through each cell in the ActiveSheet
  For Each cell In ActiveSheet.UsedRange

    'Check for a specific fill color
      If cell.Interior.Color = RGB(255, 255, 0) Then

        'Remove Fill Color
          cell.Interior.Color = xlNone

      End If

  Next cell

  Range(i).Interior.Color = i1

    ' Highlight the active cell
   ' If Target.Interior.ColorIndex = -4142 Then
   Range("a3").Value = Target.Address
   Range("a2").Value = Target.Interior.Color
    Target.Interior.ColorIndex = 6

   ' End If

    Application.ScreenUpdating = True
End Sub

Answer 2

尝试使用以下代码。这将适用于您一次只选择一个单元格的情况。你正在使用辅助细胞M1＆amp; N1存储以前的单元格范围和内部颜色索引。由于此代码使用的是ColorIndex或RGB值，因此单元格中的颜色会略微偏离原始RGB颜色，因此如果可能，请尝试将RGB颜色调整为ColorIndex spectar。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim cell As Range
'Turn off ScreenUpdating (speeds up code)
Application.ScreenUpdating = False
Range(Range("M1")).Interior.ColorIndex = Range("N1").Value
Range("M1").Value = Target.Address
Range("N1").Value = Range(Target.Address).Interior.ColorIndex

' Highlight the active cell
Range("M1").Value = Target.Address
Range("N1").Value = Range(Target.Address).Interior.ColorIndex
Target.Interior.ColorIndex = 6
Application.ScreenUpdating = True
End Sub

如果填充颜色为X的单元格更改为无填充颜色，则将单元格填充颜色返回到X

2 个答案: