excel - VBa条件删除循环不起作用

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

这是删除行的最坏方法。原因

1. 您正在删除循环中的行
2. 您的 Cells 对象不合格

尝试这个。

巧合的是，我也在 MSDN 论坛中回答了类似的问题。请看这个

试试这种方式（未测试）

在下面的代码中，我将最后一行硬编码为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

例如，如果您有“字符串”可以在不同情况下或在其他字符串之间的情况

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