vba - 按颜色突出显示相交

Question

我正在处理一些自定义格式、带状行和列以及它们相交的位置，突出显示为较暗的阴影。

两个程序一起工作。第一个(RangeBanding)按预期工作，并对偶数行和列进行绑定(bind)。

当我运行第二个(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

想要的效果:
Color intersect Example

Answer 1

多一个:

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