Question

所以我在Execl VB中有下面的脚本，它遍历行并删除那些不包含某个关键字的行。

Sub Main()
    RowsDeleted = 0
    Keyword = "COLA"
    For i = 2 to ActiveSheet.UsedRange.Rows.Count
        If InStr(Cells(i, 1).Value, Keyword) = 0 Then
            Rows(i).Delete
            RowsDeleted = RowsDeleted + 1
            i = i - 1
        End If
    Next i
    MsgBox("Rows Deleted: " & RowsDeleted)
End Sub

问题是这个脚本需要很长时间才能执行（约73,000个条目大约需要8分钟）。为什么会这样，我将如何改进呢？

Answer 1

没有其他答案的冒犯，但这只会有助于排除故障。你需要做的是删除代码行

Rows(i).Delete

在（可能）长时间运行的For循环中导致减速的原因。

你需要像这样重写它......

Sub Main()
    RowsDeleted = 0
    Keyword = "COLA"

    Dim rng As Excel.Range
    Dim arr() As Variant
    Dim str As String
    arr = ActiveSheet.UsedRange
    Dim R As Long

    For R = 1 To UBound(arr, 1) ' First array dimension is rows.
        If InStr(arr(R, 1), Keyword) = 0 Then
            If str <> "" Then
                str = "," & str
            End If
            str = str & arr(R, 1).Address
        End If
    Next R

    Set rng = ActiveSheet.Range(str)
    RowsDeleted = rng.Rows.Count
    rng.Delete

    MsgBox ("Rows Deleted: " & RowsDeleted)

End Sub

Answer 2

由于您的单元格中的公式将被删除，因此需要很长时间。

您应该做的是关闭自动计算并在删除之前清除该行的内容。你也应该自下而上开始！

试试这个：

Sub Main()
    Dim lMode As Long

    ' Store initial state of Calculation mode
    lMode = Application.Calculation
    ' Change to Manual Calculation
    Application.Calculation = xlCalculationManual
    ' Disable screen update
    Application.ScreenUpdating = False

    RowsDeleted = 0
    Keyword = "COLA"

    ' Start from bottom up!
    For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
        If InStr(Cells(i, 1).Value, Keyword) = 0 Then
            Rows(i).ClearContents
            Rows(i).Delete
            RowsDeleted = RowsDeleted + 1
        End If
    Next i

    ' Restore screenupdate and calculation mode
    Application.ScreenUpdating = True
    Application.Calculation = lMode

    MsgBox ("Rows Deleted: " & RowsDeleted)
End Sub

Answer 3

这里可以看一下，它过滤单元格A＆lt;＆gt;＆＃34; Cola＆＃34;并清除它们然后它对A列进行排序，因此A列中的空白单元格现在位于底部然后删除空白行。不知道OP的设置，可能需要进行调整。

在我的样本表上，我使用81,000行，当我运行代码时需要大约5秒。

Sub SomeDeleteCode()
    Dim Rws As Long, Rng As Range, nwRw As Long

    Rws = Cells(Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculateManual

    Columns("A:A").AutoFilter Field:=1, Criteria1:="<>*Cola*"
    Set Rng = Range(Cells(2, 1), Cells(Rws, 1)).SpecialCells(xlCellTypeVisible)
    Rng.ClearContents
    ActiveSheet.AutoFilterMode = 0

    Columns(1).Sort Key1:=Range("A1"), Header:=xlYes
    nwRw = Cells(Rows.Count, "A").End(xlUp).Row

    Range(Range("B" & nwRw + 1), Range("B" & nwRw + 1).End(xlDown)).EntireRow.Delete
    Application.Calculation = xlCalculationAutomatic
End Sub

Answer 4

修改您的代码，如下所示：

Sub Main()
    On Error Goto ErrHandler
    Application.ScreenUpdating = False

    RowsDeleted = 0
    Keyword = "COLA"
    For i = ActiveSheet.UsedRange.Rows.Count to 2
        If InStr(Cells(i, 1).Value, Keyword) = 0 Then
            Rows(i).Delete
            RowsDeleted = RowsDeleted + 1
            ' i = i - 1 ' -- manually changing the loop counter is a bad idea
        End If
    Next i
    MsgBox("Rows Deleted: " & RowsDeleted)

EndSub:
    Application.ScreenUpdating = True
    exit sub
ErrHandler:
    ' Error handling here
    resume EndSub
End Sub

错误处理程序是确保 ScreenUpdating 恢复的必要条件，即使出现错误也是如此。

VBA行操作执行时间过长

4 个答案: