VBA：For循环，不想多次迭代

Question

我编写了一个简单的代码来删除Excel工作表中的行，其中值不是数字，而且没有值。但是，奇怪的是，当我运行程序时，循环只执行一次。

如何解决这个问题，以便我的程序一次性删除符合我的两个条件的行？

Sub foo()

Dim lRow As Integer
Dim sht As Worksheet
Set sht = ActiveWorkbook.ActiveSheet

lRow = sht.Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range(sht.Cells(2, 1), sht.Cells(lRow, 1))

If (Not IsNumeric(c.Value) Or c.Value = "") Then c.EntireRow.Delete

Next

End Sub

Answer 1

这使用AutoFilter分两步删除目标行：

Criteria1:="=*"显示非空字符串，Criteria2:="="显示空值

Option Explicit

Public Sub foo()
    Application.ScreenUpdating = False
    With ActiveWorkbook.ActiveSheet.UsedRange

        'Step 1 - Remove all strings and empty values:
        .AutoFilter field:=1, Criteria1:="=*", Operator:=xlOr, Criteria2:="="
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete     'Excludes the header row

        'Step 2 - Remove all numbers that are not 6 digits in length:
        .AutoFilter field:=1, Criteria1:="<100000", Operator:=xlOr, Criteria2:=">999999"
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete     'Excludes the header row

        .AutoFilter 'Removes filter
    End With
    Application.ScreenUpdating = True
End Sub

修改

上述版本将排除标题行，该标题行将成为AutoFilter行（带箭头）

如果没有标题行，则需要进行更多检查。 例如，使用此数据：

100,000
100,001
100,003

第一个可见单元格（未包含在过滤器中）将为100,000，不应删除

如果数据是：

Abc
100,000
100,001
100,003

第一个可见单元格（未包含在过滤器中）将为Abc，应删除

因此版本2（下面提到）解决了这个问题：

Option Explicit

Public Sub foo()
    Dim rowsToDelete As Range

    Application.ScreenUpdating = False
    With ActiveWorkbook.ActiveSheet.UsedRange

        'Step 1 - Remove all strings and empty values:
        .AutoFilter Field:=1, Criteria1:="=*", Operator:=xlOr, Criteria2:="="
        Set rowsToDelete = CheckFirstCell(.Columns(1))
        If Not rowsToDelete Is Nothing Then rowsToDelete.EntireRow.Delete

        'Step 2 - Remove all numbers that are not 6 digits in length:
        .AutoFilter Field:=1, Criteria1:="<100000", Operator:=xlOr, Criteria2:=">999999"
        Set rowsToDelete = CheckFirstCell(.Columns(1))
        If Not rowsToDelete Is Nothing Then rowsToDelete.EntireRow.Delete

        .AutoFilter 'Removes filter
    End With
    Application.ScreenUpdating = True
End Sub

Private Function CheckFirstCell(ByRef rng As Range) As Range    'It can return Nothing
    If Not rng Is Nothing Then
        Dim tmp As Variant
        With rng
            .SpecialCells(xlVisible).Select
            tmp = Selection(1).Value2
            If Not IsNumeric(tmp) Or (tmp < 100000 Or tmp > 999999) Or Len(tmp) = 0 Then
                Set CheckFirstCell = .EntireRow
            End If
            If Selection.Count > 1 Then
                If CheckFirstCell Is Nothing Then
                    Set CheckFirstCell = .Offset(1).Resize(.Rows.Count - 1).EntireRow
                Else
                    Set CheckFirstCell = .EntireRow
                End If
            End If
            .Cells(1).Select
        End With
    End If
End Function