如何保持初始单元格颜色,而代码突出显示活动行

时间:2013-09-21 06:45:00

标签: excel excel-vba vba

我有工作簿的代码:

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

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

2 个答案:

答案 0 :(得分:1)

该死的,我找不到加载项,但我为你重新创建了代码。请注意,这尚未经过全面测试。无论我做了什么小测试,它都有效......

<强>逻辑

  1. 创建隐藏的工作表。
  2. 将当前单元格的格式存储在该隐藏工作表的第1行
  3. 将当前选定的活动工作表中的行号存储到隐藏工作表的单元格A2
  4. 当您移动到另一行时,请检索最后一行并恢复它。
  5. <强>代码

    在此工作簿代码区域

    enter image description here

    Private Sub Workbook_Open()
        Dim ws As Worksheet
    
        '~~> Delete the Temp sheet we created i.e 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作为示例

    enter image description here

    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
    

    <强>截图

    enter image description here

答案 1 :(得分:1)

这是一种替代方法,它利用了Excel总是在页面上已经存在的任何格式之上“覆盖”条件格式的事实。

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

使用公式=(ROW()=ROWNUM)添加条件格式,并添加要用于行突出显示的任何格式。

您的SelectionChange子只是:

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