Question

我在电子表格上运行以下代码：

Do While i <= 100000
    If Not Cells(i, 4) = "String" Then
        Cells(i, 4).EntireRow.Delete
    End If
    i = i + 1
Loop

有很多条目不“字符串”，但它们不会被删除。

当我将这段代码复制到单独的工作表时，我甚至得到错误“Excel无法使用可用资源完成此任务。选择较少的数据或关闭其他应用程序。”

我做错了是什么让这个循环不起作用？

注意：我无法使用自动过滤，因为我需要删除基于而不是符合条件的行。

Answer 1

这是删除行的最糟糕方式。原因

您正在删除循环中的行
您的单元格对象不合格

试试这个。

同时我也在MSDN论坛上回答了类似的问题。请参阅THIS

试试这种方式（UNTESTED）

在下面的代码中，我将最后一行硬编码为100000，与上述链接不同。

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long
    Dim delRange As Range

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        For i = 1 To 100000
            If .Cells(i, 4).Value <> "String" Then
                If delRange Is Nothing Then
                    Set delRange = .Rows(i)
                Else
                    Set delRange = Union(delRange, .Rows(i))
                End If
            End If
        Next i

        If Not delRange Is Nothing Then delRange.Delete
    End With
End Sub

注意：我假设某个单元格的值为

String
aaa
bbb
ccc
String

如果您的场景中有＆＃34; String＆＃34;可以在不同的情况下或在其他字符串之间，例如

String
aaa
STRING
ccc
dddStringddd

然后你必须采取一种稍微不同的方法，如该链接所示。

Answer 2

自动过滤器代码：

Sub QuickCull()
    Dim rng1 As Range

    Set rng1 = Range([d4], Cells(Rows.Count, "D").End(xlUp))
    ActiveSheet.AutoFilterMode = False

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    With rng1
        .AutoFilter Field:=1, Criteria1:="<>string"
        If rng1.SpecialCells(xlCellTypeVisible).Count > 1 Then _
        .Offset(1, 0).Resize(rng1.Rows.Count - 1).Rows.Delete
    End With

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    ActiveSheet.AutoFilterMode = False
End Sub

Answer 3

如果要删除行，最好从底部删除。

Sub DeleteData()

    Dim r As Long
    Dim Rng As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Sheets("sheet1")

        Set Rng = .Range(.Range("D1"), .Range("D1").End(xlDown))

        For r = Rng.Rows.Count To 1 Step -1
            If LCase(Trim(.Cells(r, 4).Value)) <> LCase("string") Then
                .Cells(r, 4).EntireRow.Delete
            End If
        Next

    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 4

这是一个基本的算法错误。

想象一下你的程序在第10行。你删除它。因此，第11行变为第10行，第12行变为11，依此类推。然后你去第11行，跳过第10行，前一行11！

这样可行：

Do While i <= 100000
    If Not Cells(i, 4) = "String" Then
        Cells(i, 4).EntireRow.Delete
    Else
        i = i + 1
    End If
Loop

VBa条件删除循环不起作用

4 个答案: