突出显示与颜色相交

我正在处理一些自定义格式,带状行和列以及它们相交的地方,突出显示一个较暗的阴影。

两个程序一起工作。 第一个(RangeBanding)按照预期工作,并将偶数行和列组合起来。

当我运行第二个(IntersectColor),事情开始横向。 我无法确定要更改颜色的单元格的引用。 在我面前也许是正确的,但无论If / Else或Case还是Intersect的顺序,我都无法获得参考。

我已经评论过我以前工作的一些方向。

任何帮助表示赞赏,谢谢!

Sub RangeBanding() Dim rw As Range Dim col As Range Dim rng As Range Dim cell As Range Set rng = Range("TestRange") ' For each row in range,if even band color For Each rw In rng.Rows If Not IsOdd(rw.Row) Then rw.Interior.Color = RGB(241, 241, 241) Next rw ' For each column in range, if even band color For Each col In rng.Columns If Not IsOdd(col.Column) Then col.Interior.Color = RGB(241, 241, 241) Next col End Sub Sub IntersectColor() Set rng = Range("TestRange") For Each cell In rng ' cell select to watch step in debug cell.Select On Error Resume Next If cell.Offset.Interior.Color = xlNone Then cell.Interior.Color = xlNone ElseIf (cell.Interior.Color = RGB(241, 241, 241)) And _ (cell.Offset(0, -1).Interior.Color = xlNone) Then cell.Interior.Color = RGB(241, 241, 241) ElseIf (cell.Interior.Color = RGB(241, 241, 241)) And _ (cell.Offset(-1, -1).Interior.Color = RGB(241, 241, 241)) Then cell.Interior.Color = RGB(217, 217, 217) End If 'Select Case cellcolor 'Case Is = (ActiveCell.Interor.Color = RGB(241, 241, 241)) And (ActiveCell.Offset(1, 1).Interior.Color = xlNone) ' ActiveCell.Interior.Color = RGB(217, 217, 217) 'End Select Next cell End Sub Function IsOdd(ByVal l As Long) As Boolean IsOdd = l Mod 2 End Function 

期望的效果: 颜色相交示例

多一个:

 Option Explicit Public Sub RangeBanding() Dim itm As Range, isEven As Boolean, isXing As Boolean Dim clr1 As Long, clr2 As Long, clrW As Long, clr As Long clr1 = RGB(241, 241, 241) 'light clr2 = RGB(217, 217, 217) 'dark clrW = xlNone 'transparent (white) Application.ScreenUpdating = False For Each itm In ThisWorkbook.Sheets(1).Range("TestRange").Cells With itm isEven = .Row Mod 2 = 0 Or .Column Mod 2 = 0 isXing = .Row Mod 2 = 0 And .Column Mod 2 = 0 clr = clrW Select Case True Case isXing: clr = clr2 'must be first in the select statement Case isEven: clr = clr1 End Select .Interior.Color = clr End With Next Application.ScreenUpdating = True End Sub 
 Sub RangeBanding() Dim rw As Range Dim col As Range Dim rng As Range Dim cell As Range Set rng = Range("TestRange") ' For each row in range,if even band color For Each rw In rng.Rows If Not IsOdd(rw.Row) Then rw.Interior.Color = RGB(241, 241, 241) Next rw ' For each column in range, if even band color For Each col In rng.Columns If Not IsOdd(col.Column) Then col.Interior.Color = RGB(241, 241, 241) Next col For Each cell In rng.Cells If Not IsOdd(cell.Column) And Not IsOdd(cell.Row) Then col.Interior.Color = RGB(217, 217, 217) Next col End if End Sub 

一对条件格式化规则应该照顾到这一点。

 With Range("TestRange") .FormatConditions.Delete With .FormatConditions.Add(Type:=xlExpression, Formula1:="=AND(NOT(MOD(ROW(), 2)),NOT(MOD(COLUMN(), 2)))") .Interior.Color = RGB(217, 217, 217) .StopIfTrue = True End With With .FormatConditions.Add(Type:=xlExpression, Formula1:="=OR(NOT(MOD(ROW(), 2)),NOT(MOD(COLUMN(), 2)))") .Interior.Color = RGB(241, 241, 241) .StopIfTrue = True End With End With 

在这里输入图像说明