Question

当满足某些条件时，我可以使用此子项来删除一行。但是，我发现它花费了太多时间来运行。有什么办法可以使运行速度更快？

'This sub deletes the row that has any of the following values

Dim ws As Worksheet, i&, lastrow&, value$
Set ws = ActiveWorkbook.Sheets("Product Qty")
lastrow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = lastrow To 2 Step -1
    value = ws.Cells(i, 2).value
    ' Check if it contains one of the keywords.
    If (value Like "*VOI*" _
        Or value Like "*SLOC*" _
        Or value Like "*NCM*" _
        Or value Like "*RTS*" _
        Or value Like "*VND*" _
        Or value Like "*DFFC*" _
        Or value Like "*STOR*") _
        Then
        ' Protected values found. Delete the row.
        ws.Rows(i).delete
    End If
Next
Application.ScreenUpdating = True

Answer 1

两件事可以使您的代码更快：

将数据读入数组并遍历该数组而不是范围。遍历数组比遍历范围要快。
使用Application.Union method在范围变量RowsToDelete中收集要删除的所有行，并最后一次将其全部删除。

请注意，我建议不要使用Value作为变量名，因为这很容易与范围的.Value属性混淆。

Option Explicit

Sub DeleteRows()
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Product Qty")

    Dim LastRow As Long
    LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

    'read data into array
    DataArr() As Variant
    DataArr = ws.Range("B1", "B" & LastRow).value

    Dim ChkVal As String

    'we collect all rows in a range using union
    Dim RowsToDelete As Range

    Dim iRow As Long
    For iRow = 2 To UBound(DataArr, 1)
        ChkVal = DataArr(iRow, 1)
        ' Check if it contains one of the keywords.
        If (ChkVal Like "*VOI*" _
            Or ChkVal Like "*SLOC*" _
            Or ChkVal Like "*NCM*" _
            Or ChkVal Like "*RTS*" _
            Or ChkVal Like "*VND*" _
            Or ChkVal Like "*DFFC*" _
            Or ChkVal Like "*STOR*") Then
            ' Protected values found.
            If RowsToDelete Is Nothing Then 'first row
                Set RowsToDelete = ws.Rows(iRow)
            Else 'all following rows
                Set RowsToDelete = Union(RowsToDelete, ws.Rows(iRow))
            End If
        End If
    Next

    'delete all rows
    If Not RowsToDelete Is Nothing Then RowsToDelete.Delete
End Sub

Answer 2

如果您需要多个通配符条件，则还可以通过自动过滤器来实现：

放置一个范围内的过滤条件（在另一张纸上）
使用范围进行自动过滤
删除所有行

标准行是OR组合的，可以放在其他工作表上的任意位置：

下面，在critera上方定义了要删除的所有行：

Private Sub DeleteRowsFast()
    Dim ws As Worksheet, fs As Worksheet
    Set ws = ActiveSheet
    Set fs = Sheets("FilterSheet")
    ws.UsedRange.AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=fs.Range("Filter1"), _
        Unique:=False
    ws.Rows("2:1000000").Delete Shift:=xlUp  ' delete visible rows
    ws.ShowAllData
End Sub

如何更快地删除行？

2 个答案: