使用Worksheet.BeforeDoubleClick事件覆盖条件格式

时间:2019-01-18 00:10:08

标签: excel vba

我正在使用此规则根据B列中的条件来设置其他所有行的格式:

=IF(ISEVEN(LEFT($B1, FIND("-", $B1)-1)),MOD(ROW(),2))

我还希望能够双击特定列中的单元格,以切换突出显示该行的方式:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, tb.ListColumns("Domain").DataBodyRange) Is Nothing Then
        Cancel = True
        Target.Name = "HighlightRow"
        With ActiveCell
            Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 36
        End With
    End If
End Sub
  1. 参考this answer,如何覆盖规则,以便Worksheet.BeforeDoubleClick事件优先?
  2. 如何调整Worksheet.BeforeDoubleClick事件以切换突出显示?

1 个答案:

答案 0 :(得分:1)

在我开始之前...我有点困惑,您的条件格式公式应该是

=IF(ISEVEN(LEFT($B1, FIND("-", $B1)-1)),MOD(ROW(),2))

...仅在每个奇数行的B列中仅格式化偶数吗?
遗漏所有奇数和所有偶数行?


无论如何,您需要将有关哪些单元格突出显示的额外信息存储在条件格式可以使用的位置。

简便方法...

最简单的建议是添加一个名为Highlight的隐藏列,并以条件格式进行引用。


还是艰难的方式...

您可以添加优先级高的条件格式,并阻止其他格式的应用。我仍然使用其他解决方案中的“命名范围”构想。我本可以使用变量来跟踪突出显示的范围,但是我认为这样做效果更好。我也这样做了,以便您可以有多种颜色(但是我没有添加优先级)。
 享受...(我做到了)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Range("B:B"), Target) Is Nothing Then
        ToggleHighlight Target.EntireRow, Range("A2:H50")
        Cancel = True
    End If
End Sub

切换突出显示

Sub ToggleHighlight(Target As Range, _
           Optional TableArea As Range = Cells, _ 
           Optional Name As String = "Yellow", _
           Optional ColorIndex As Integer = 19)
Dim Formula As String
Dim HighlightedRows As Range
    ' Use unique names to allow multiple highlights/colors
    ' This is the formula we will apply to the highlighted area
    Formula = "=OR(TRUE,""Highlight""=""" & Name & """)"        

    On Error Resume Next
    ' Check if the target cell that was clicked is within the table area
    Set Target = Intersect(Target, TableArea)
    If Target is Nothing Then Exit
    ' Get the current highlighted rows
    Set HighlightedRows = ThisWorkbook.Names("HighlightedRows_" & Name).RefersToRange
    ThisWorkbook.Names("HighlightedRows_" & Name).Delete
    On Error GoTo 0

    If HighlightedRows Is Nothing Then
        Set HighlightedRows = Target    ' We'll apply .EntireRow later
    Else
        ' Remove previous Conditional Formats
        Dim Condition As FormatCondition
        For Each Condition In HighlightedRows.FormatConditions
            With Condition
                If .Formula1 = Formula Then .Delete
            End With
        Next
        ' Now, toggle the Target range/row
        If Intersect(HighlightedRows, Target) Is Nothing Then
            ' We know that both HighlightedRows and Target are Not Nothing, so
            Set HighlightedRows = Union(HighlightedRows, Target.EntireRow)
        Else
            ' We're going to limit the (Big) area to a single column, because it's slow otherwise
            Set HighlightedRows = InvertRange(Target.EntireRow, Intersect(HighlightedRows, TableArea.Columns(1)))
        End If
    End If
    ' Apply the new Conditional Formatting...
    If Not HighlightedRows Is Nothing Then
        ' HighlightedRows is still set to the EntireRow
        Set HighlightedRows = Intersect(HighlightedRows.EntireRow,TableArea)
        With HighlightedRows
            .Name = "HighlightedRows_" & Name
            .FormatConditions.Add Type:=xlExpression, Formula1:=Formula
            With .FormatConditions(.FormatConditions.Count)
                ' Make sure it's first
                .SetFirstPriority
                ' and that no other format is applied
                .StopIfTrue = True
                .Interior.ColorIndex = ColorIndex
            End With
        End With
    End If
End Sub

反转范围

Function InvertRange(Target As Excel.Range, Optional LargeArea As Variant) As Excel.Range
' Returns the Inverse or Relative Complement of Target in LargeArea
' InvertRange = LargeArea - Target
Dim BigArea As Excel.Range
Dim Area As Excel.Range
Dim Cell As Excel.Range

    If IsMissing(LargeArea) Then
        Set BigArea = Target.Parent.UsedRange
    Else
        Set BigArea = LargeArea
    End If

    If Target Is Nothing Then
        Set InvertRange = BigArea
    ElseIf BigArea Is Nothing Then
        ' nothing to do; will return Nothing
    Else
        For Each Area In BigArea.Areas
            For Each Cell In Area.Cells
                If Intersect(Cell, Target) Is Nothing Then
                    If InvertRange Is Nothing Then
                        Set InvertRange = Cell
                    Else
                        Set InvertRange = Union(InvertRange, Cell)
                    End If
                End If
            Next Cell
        Next Area
    End If
End Function

编辑

我对其进行了更新,包括TableArea,以限制突出显示,并检查“目标”和“表区域”是否在同一张纸上并且相交。