VBA循环未正常循环

Question

当我遍历for循环时，它一开始能够工作，但是随着我向下移动列，单元格既没有被删除也没有被标红。

For i = 2 To lngRow
    
    If Cells(i, 27).Value = "Completed" Or IsEmpty(Cells(i, 27).Value) = True Then
        'Do nothing
    Else
        'Go into the exception items'
        If Cells(i, 28).Value = "Contact Information Not Found" Then
            'Check Code: If identifiable (4 digits long + starts with a F), highlight
            If Len(Cells(i, 4).Value) = 4 And Left(Cells(i, 4), 1) = "F" Then
                Cells(i, 28).Interior.Color = RGB(255, 0, 0)
            Else
                'Otherwise, delete
                Rows(i).EntireRow.Delete
            End If
                
        ElseIf Cells(i, 28).Value = "Invalid Account Number." Then
        End If
    End If
        
Next i

- tangerinev43

---

当您删除一行时，它会破坏您的索引。删除第1行，现在第2行变成了第1行。如果可以，请向后运行循环，或在删除项目时手动调整索引。 - NickSlash

Answer 1

向后循环：

For i = lngRow To 2 Step-1   'here

    If Cells(i, 27).Value <> "Completed" And IsEmpty(Cells(i, 27).Value) = False Then
         'Go into the exception items'
        If Cells(i, 28).Value = "Contact Information Not Found" Then
            'Check Code: If identifiable (4 digits long + starts with a F), highlight
            If Len(Cells(i, 4).Value) = 4 And Left(Cells(i, 4), 1) = "F" Then
                Cells(i, 28).Interior.Color = RGB(255, 0, 0)
            Else
            'Otherwise, delete
                Rows(i).EntireRow.Delete
            End If
            
        ElseIf Cells(i, 28).Value = "Invalid Account Number." Then
        End If
    End If
    
Next i

- DerinNehir

---

这比在循环体中处理For循环计数器变量好多了，强烈建议使用这种方式。更好的方法是向前迭代并有条件地Union行以构建包含所有要删除行的Range，然后一次性删除它们（比逐个删除那么多行更有效率，每次都会触发表格重新计算）。 - Mathieu Guindon

Answer 2

尝试在删除语句下面添加以下行。 （我正在使用手机，所以无法很好地编辑）

' otherwise, delete
Rows(i).EntireRow.Delete
i=i-1 'adjust the index

您可能需要每次调整lngRow，以避免尝试处理数据底部的空行。

- NickSlash

---

太好了，完美运作。非常感谢你！ - tangerinev43

Answer 3

颜色和删除

• 如果您添加了Sub和End Sub并定义了lngRow，它将成为一个最小可重现示例。
• 我更喜欢有意义的变量名，比如LastRow，而不是匈牙利命名法中的lngRow，现在在这个网站上很少见。
• 当您在一行中评估两个条件时，两个条件都会被评估。当第一个已经是False时，为什么还要评估第二个呢？
• 创建一个像builtRange这样的过程，并使用它来“构建”（“组合”）范围，将比每次访问工作表更有效。使用它将只减少对工作表的访问一次（每个操作）。
• 最后一个过程只是关于如何针对非空单元格（而不是非空单元格）进行测试的想法。其中包括，最好使用If Len(cel.value) > 0 Then来完成。它创建一个新的工作簿并在其中执行操作，因此所有其他工作簿都是安全的。

代码

Option Explicit

Sub colorOrDelete()
    
    Dim LastRow As Long: LastRow = 20
    
    Dim drg As Range ' Delete Range
    Dim crg As Range ' Color Range
    Dim i As Long ' Worksheet Rows Counter
    
    For i = 2 To LastRow
        If Not IsEmpty(Cells(i, 27)) Then
            If Cells(i, 27).Value <> "Completed" Then
                If Cells(i, 28).Value = "Contact Information Not Found" Then
                    If Len(Cells(i, 4).Value) = 4 Then
                        If Left(Cells(i, 4), 1) = "F" Then
                            buildRange crg, Cells(i, 28)
                        Else
                            buildRange drg, Rows(i)
                        End If
                    End If
                End If
            ' An Idea
            'ElseIf Cells(i, 28).Value = "Invalid Account Number." Then
            'Else
            End If
        End If
    Next i
    
    Dim hasChanged As Boolean
    
    Application.ScreenUpdating = False
    
    ' You wanna color the cells before deleting the rows.
    If Not crg Is Nothing Then
        hasChanged = True
        crg.Interior.Color = RGB(255, 0, 0)
    End If
    
    If Not drg Is Nothing Then
        If Not hasChanged Then
            hasChanged = True
        End If
        drg.Delete
    End If

    Application.ScreenUpdating = True
    
    If hasChanged Then
        MsgBox "Operation finished.", vbInformation, "Success"
    Else
        MsgBox "Done nothing.", vbExclamation, "No Change"
    End If
    
End Sub

Sub buildRange( _
        ByRef builtRange As Range, _
        AddRange As Range)
    If builtRange Is Nothing Then
        Set builtRange = AddRange
    Else
        Set builtRange = Union(builtRange, AddRange)
    End If
End Sub

一些想法

Sub buildRangeParanoia( _
        ByRef builtRange As Range, _
        AddRange As Range)
    If Not AddRange Is Nothing Then
        If builtRange Is Nothing Then
            Set builtRange = AddRange
        Else
            If AddRange.Worksheet Is builtRange.Worksheet Then
                Set builtRange = Union(builtRange, AddRange)
            End If
        End If
    End If
End Sub

Sub EmptyVsBlank()
    
    Dim wb As Workbook: Set wb = Workbooks.Add
    
    With wb.Worksheets(1)
        
        Dim cel1 As Range: Set cel1 = .Range("A1"): cel1.Value = Empty
        Dim cel2 As Range: Set cel2 = .Range("A2"): cel2.Value = "="""""
        Dim cel3 As Range: Set cel3 = .Range("A3"): cel3.Value = "'"
        
        Debug.Print IsEmpty(cel1), IsEmpty(cel1.Value), Len(cel1.Value)
        Debug.Print IsEmpty(cel2), IsEmpty(cel2.Value), Len(cel2.Value)
        Debug.Print IsEmpty(cel3), IsEmpty(cel3.Value), Len(cel3.Value)
        
        Dim rg As Range: Set rg = .Range("A1:A3")
        Debug.Print Application.CountA(rg) ' A2, A3
        Debug.Print Application.CountBlank(rg) ' A1, A2, A3
        ' The Shock
        Debug.Print Application.CountIf(rg, Empty) ' None
        Debug.Print Application.WorksheetFunction.CountIf(rg, Empty) ' None
   
        .Parent.Saved = True ' To close without prompt.
        '.Parent.Close SaveChanges:=False
   
   End With
    
    ' Result:
    ' True          True           0
    ' False         False          0
    ' False         False          0
    ' 2
    ' 3
    ' 0
    ' 0

End Sub

- VBasic2008