Question

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

两个程序一起工作。第一个（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

期望效果： Color intersect Example

Answer 1

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

Answer 2

一对条件格式规则应该处理这个问题。

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

Answer 3

还有一个：

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

突出显示颜色相交

3 个答案: