如何保持初始单元格的颜色，而代码是高亮活动行

我有这个工作簿的代码：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 'toggles worksheet colors 'code will remove all color 'and color active row and column If ActiveCell.Interior.ColorIndex <> xlNone Then Cells.Interior.ColorIndex = xlNone Else Cells.Interior.ColorIndex = xlNone ActiveCell.EntireRow.Interior.ColorIndex = 4 End If End Sub 

并且运作良好。 但如果一行有一个初始的颜色，它将被删除。 让我知道如何激活行将突出显示，并通过更改行，将获得其初始颜色？

Answer 1

该死，我无法find加载项，但我重新为您创build了代码。 请注意，这是没有彻底testing。 在我做的任何小testing中，它都能正常工作。

逻辑 ：

1. 创build一个隐藏的表单。
2. 将当前单元格的格式存储在该隐藏工作表的第1行中
3. 将当前选中的行号存储在活动工作表中的单元格A2中
4. 当你移动到不同的行，然后检索最后一个行号，并恢复它。

代码 ：

在这个工作簿代码区域

 Private Sub Workbook_Open() Dim ws As Worksheet '~~> Delete the Temp sheet we created ie if we created Application.DisplayAlerts = False On Error Resume Next Sheets("MyHiddenSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True '~~> ReCreate the Sheet Set ws = ThisWorkbook.Sheets.Add '~~> i am using a normal name. Chnage as applicable ws.Name = "MyHiddenSheet" '~~> Hide the sheet ws.Visible = xlSheetVeryHidden End Sub 

在相关的表单代码区域。 我以Sheet1为例

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) '~~> Don't do anything if multiple cells are selected If Target.Cells.CountLarge > 1 Then Exit Sub Dim ws As Worksheet '~~> Set our relevant sheet Set ws = ThisWorkbook.Sheets("MyHiddenSheet") '~~> Get the row number of the last row we had selected earlier '~~> For obvious reasons, this will be empty for the first use. If Len(Trim(ws.Cells(2, 1).Value)) <> 0 Then '~~> If user has moved to another row then '~~> Restor the old row If Target.Row <> Val(ws.Cells(2, 1).Value) Then ws.Rows(1).Copy Rows(ws.Cells(2, 1).Value).PasteSpecial xlFormats End If End If '~~> Copy the current row's format to the hidden sheet Rows(Target.Row).Copy ws.Rows(1).PasteSpecial xlFormats '~~> Store the current rows value in cell A2 ws.Cells(2, 1).Value = Target.Row '~~> Highlight the current row in a shade of blue. '~~> Chnage as applicable With Rows(Target.Row).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 Rows(Target.Row).Select End With '~~> Remove the `Ants` which appear after you do a copy Application.CutCopyMode = False End Sub 

屏幕截图 ：

Answer 2

这里有一个替代的方法，它利用了Excel总是“覆盖”条件格式的任何格式已经在表单上的事实。

定义工作表级名称“ROWNUM”并赋值为0。

使用公式=(ROW()=ROWNUM)添加条件格式，然后添加要用于行高亮显示的任何格式。

您的SelectionChange子然后只是：

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Me.Names("ROWNUM").RefersToR1C1 = "=" & Target.Cells(1).Row End Sub