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



我使用此规则根据列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. 关于这个答案,我如何重写规则,以便Worksheet.BeforeDoubleClick事件优先
  2. 如何调整工作表。双击事件之前切换高亮显示

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

=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,以限制Highlights,以及检查Target和TableArea是否在同一张图纸上并相交。

相关内容

  • 没有找到相关文章

最新更新