您需要存储原始颜色以及单元格引用。此外,用户可能会选择多个单元格,每个单元格都可能有自己的颜色。
这里是处理这些复杂性的起点。请注意,这说明了用户选择 >= 1 个单元格的连续范围。他们还可以选择不连续的多单元格范围。第二个更复杂的版本提供了这个
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static rngcolor As Range
Static OldColor As Variant
Dim rw As Long, cl As Long
If Not rngcolor Is Nothing Then
If IsArray(OldColor) Then
On Error GoTo NoRestore
For rw = 1 To rngcolor.Rows.Count
For cl = 1 To rngcolor.Columns.Count
If IsEmpty(OldColor(rw, cl)) Then
rngcolor.Cells(rw, cl).Interior.ColorIndex = xlNone
Else
rngcolor.Cells(rw, cl).Interior.Color = OldColor(rw, cl)
End If
Next
Next
On Error GoTo 0
Else
If IsEmpty(OldColor) Then
rngcolor.Interior.ColorIndex = xlNone
Else
rngcolor.Interior.Color = OldColor
End If
End If
End If
NoRestore:
On Error GoTo 0
Set rngcolor = Target
ReDim OldColor(1 To Target.Rows.Count, 1 To Target.Columns.Count)
For rw = 1 To Target.Rows.Count
For cl = 1 To Target.Columns.Count
If Target.Cells(rw, cl).Interior.ColorIndex = xlNone Then
OldColor(rw, cl) = Empty
Else
OldColor(rw, cl) = Target.Cells(rw, cl).Interior.Color
End If
Next
Next
rngcolor.Interior.Color = vbYellow
End Sub
考虑非连续范围选择的版本
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static rngcolor As Range
Static OldColor As Variant
Dim OldColrRng As Variant
Dim ar As Long, rw As Long, cl As Long
If Not rngcolor Is Nothing Then
If IsArray(OldColor) Then
On Error GoTo NoRestore
For ar = 1 To rngcolor.Areas.Count
For rw = 1 To rngcolor.Areas(ar).Rows.Count
For cl = 1 To rngcolor.Areas(ar).Columns.Count
If IsEmpty(OldColor(ar)(rw, cl)) Then
rngcolor.Areas(ar).Cells(rw, cl).Interior.ColorIndex = xlNone
Else
rngcolor.Areas(ar).Cells(rw, cl).Interior.Color = OldColor(ar)(rw, cl)
End If
Next
Next
Next
On Error GoTo 0
Else
If IsEmpty(OldColor) Then
rngcolor.Interior.ColorIndex = xlNone
Else
rngcolor.Interior.Color = OldColor
End If
End If
End If
NoRestore:
On Error GoTo 0
Set rngcolor = Target
ReDim OldColor(1 To Target.Areas.Count)
For ar = 1 To Target.Areas.Count
ReDim OldColrRng(1 To Target.Areas(ar).Rows.Count, 1 To Target.Areas(ar).Columns.Count)
OldColor(ar) = OldColrRng
Next
For ar = 1 To Target.Areas.Count
For rw = 1 To Target.Areas(ar).Rows.Count
For cl = 1 To Target.Areas(ar).Columns.Count
If Target.Areas(ar).Cells(rw, cl).Interior.ColorIndex = xlNone Then
OldColor(ar)(rw, cl) = Empty
Else
OldColor(ar)(rw, cl) = Target.Areas(ar).Cells(rw, cl).Interior.Color
End If
Next
Next
Next
rngcolor.Interior.Color = vbYellow
End Sub
注意:使用静态(或全局)变量很容易被此代码或其他代码中的错误停止。根据恢复颜色的重要性,您可能希望将 Range 引用和颜色存储在其他地方:例如,在(隐藏)工作表上的单元格中,在(隐藏)名称中,在外部存储库中(例如,文本或 ini 文件,在注册表等),或在CustomXmlPart