着色行在 23 行后中断

Question

我有下面的代码，它应该根据上面行的颜色来为行着色。然而，当我运行代码时，结果与预期的大约 15 行一样，然后它停止工作并开始在仅包含文本的行中着色。

Private Sub CommandButton1_Click()

Dim Counter, No_Of_Rows, Last_Delete, No_Of_Cols As Long
Dim Col_Letter, Col_Range As String

No_Of_Rows = Cells(Rows.Count, 1).End(xlUp).Row
No_Of_Cols = Cells(2, Columns.Count).End(xlToLeft).Column

Counter = 7
Last_Delete = 1
Col_Letter = Chr(No_Of_Cols + 64)
Col_Range = "A1" & ":" & Col_Letter & "1"

Do While Counter <= No_Of_Rows
    If Cells(Counter, 1) = "Delete" Then
        Rows(Counter).Range(Col_Range).Interior.Color = RGB(153, 51, 0)
        Last_Delete = Last_Delete + 1
    ElseIf Cells(Counter, 1) = " " Or IsEmpty(Cells(Counter, 1)) Or Cells(Counter, 1) = "" Then
        Rows(Counter).Range(Col_Range).Interior.Color = Rows(Counter - 1).Cells(1, Counter - 1).Interior.Color
    Else
        If Last_Delete = 1 Then
            If Rows(Counter - 1).Cells(1, Counter - 1).Interior.Color = RGB(255, 255, 255) Then
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(221, 217, 196)
            Else
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(255, 255, 255)
            End If
        Else
            If Rows(Counter - Last_Delete).Cells(1, Counter - 1).Interior.Color = RGB(255, 255, 255) Then
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(221, 217, 196)
                Last_Delete = 1
            Else
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(255, 255, 255)
                Last_Delete = 1
            End If
        End If
    End If
    
    Counter = Counter + 1
    
    Loop

End Sub

我不知道为什么会发生这种情况，我已经更改了周围的值，并且在几次迭代后仍然出现错误。

Answer 1

Private Sub CommandButton1_Click()

    Dim ws As Worksheet, LastRow As Long, NoOfColumns As Long
    Dim dColor As Long, dLastColor As Long, r As Long
    Dim COLOR1 As Long, COLOR2 As Long, COLOR3 As Long
    
    COLOR1 = RGB(255, 255, 255)
    COLOR2 = RGB(221, 217, 196)
    COLOR3 = RGB(153, 51, 0) ' delete
    dLastColor = COLOR1
    
    Set ws = ActiveSheet
    With ws
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        NoOfColumns = .Cells(2, .Columns.Count).End(xlToLeft).Column
        
        For r = 7 To LastRow
        
            If .Cells(r, 1) = "Delete" Then
                dColor = COLOR3
            ElseIf IsEmpty(.Cells(r, 1)) Or Len(Trim(.Cells(r, 1))) = 0 Then
                ' no change
                dColor = dLastColor
            Else
                ' toggle color
                If dLastColor = COLOR1 Then
                    dColor = COLOR2
                Else
                    dColor = COLOR1
                End If
                dLastColor = dColor
            End If
            
            ' color row
            .Cells(r, 1).Resize(, NoOfColumns).Interior.Color = dColor
        
        Next
    End With

End Sub