For循环结束变量不改变

Question

我编写了一个非常简单的循环，它遍历表格列并将负值着色为红色，正值着色为绿色并删除空行。

删除行时会出现问题。我更新了RowCount 的值，并补偿i 以再次检查同一行，因为刚刚删除了一行。如果我有一列有 10 行，其中 2 行是空的，它们将被删除。我希望For i = 1 to RowCount 会在 8 处停止，但它会继续到 9 并产生错误，因为它随后会尝试删除不存在的第 9 行。

我需要做什么才能使循环在 8 处停止而不是继续（我假设 RowCount 的初始值。

Sub ColourFilledCells()
    Dim Table1 As ListObject
    Set Table1 = ThisWorkbook.Worksheets(1).ListObjects(1)

    Dim i As Lon, RowCount As Long

    RowCount = Table1.ListRows.Count

    For i = 1 To RowCount
        If Not Table1.DataBodyRange(i, 1) = Empty Then
            With Table1.DataBodyRange(i, 1)
                If .Value < 0 Then
                    .Interior.Color = RGB(255, 0, 0)
                ElseIf .Value > 0 Then
                    .Interior.Color = RGB(0, 255, 0)
                Else
                    .ColorIndex = 0
                End If
            End With
        ElseIf Table1.DataBodyRange(i, 1) = Empty Then
            Table1.ListRows(i).Delete
            RowCount = RowCount - 1
            i = i - 1
        End If
    Next i

End Sub

Answer 1

为避免删除影响 For 循环的问题，请倒数。

你的代码，重构（加上一些建议）

For i = RowCount to 1 Step -1
    If Not isempty( Table1.DataBodyRange(i, 1)) Then
        With Table1.DataBodyRange(i, 1)
            If .Value < 0 Then
                .Interior.Color = vbRed
            ElseIf .Value > 0 Then
                .Interior.Color = vbGreen
            Else
                .ColorIndex = xlColorIndexNone
            End If
        End With
    Else 
        Table1.ListRows(i).Delete
    End If
Next i

Answer 2

试试这个代码：

Sub ColourFilledCells()
Dim Table1 As ListObject
Dim uRng As Range

Set Table1 = ThisWorkbook.Worksheets(1).ListObjects(1)

Dim i As Long, RowCount As Long

RowCount = Table1.ListRows.Count

For i = 1 To RowCount
    If Not Table1.DataBodyRange(i, 1) = Empty Then
        With Table1.DataBodyRange(i, 1)
            If .Value < 0 Then
                .Interior.Color = RGB(255, 0, 0)
            ElseIf .Value > 0 Then
                .Interior.Color = RGB(0, 255, 0)
            Else
                .ColorIndex = 0
            End If
        End With
    ElseIf Table1.DataBodyRange(i, 1) = Empty Then            
        If uRng Is Nothing Then
          Set uRng = Table1.ListRows(i).Range
        Else
          Set uRng = Union(uRng, Table1.ListRows(i).Range)            
        End If

    End If
Next i

If Not uRng Is Nothing Then uRng.Delete xlUp

End Sub