提高 For 循环效率 VBA

Question

目前我在 excel 电子表格中导入了 10Kx15 行的原始数据。我有许多已清理的字段，但感兴趣的是一个名为 "Hazard" 的字段。对于遇到的每个危险实例，我们都需要将其删除。

这是我用来清理（部分）我的数据集的代码：

Sub dataCleanse()
Dim Last

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Last = Cells(Rows.Count, "F").End(xlUp).Row
For i = Last To 1 Step -1
    If (Cells(i, "F").Value) = "Hazard" Then
        Cells(i, "A").EntireRow.Delete
    End If
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

处理 10,000 条左右的记录需要 10-15 秒。我尝试过使用自动过滤器，但是当我使用 .EntireRow.Delete 时，它会删除过滤条件下的行。即如果我们有第 1 行和第 3 行 'Hazard' 并使用自动过滤器，它也会删除没有 'Hazard'.

的第 2 行

我还先将计算设置为手动，然后再设置为自动，这样就不会每次都刷新。

有什么建议可以提高我的宏速度吗？

谢谢！

Answer 1

我不确定这是否会更快，但我的建议是 select F 列，找到 "Hazard" 的实例，删除该行，然后重复该过程直到 [=15] =] 在 F 列中找不到。

Dim iRow As Integer

Application.ScreenUpdating = False
Columns("F:F").Select

Set RangeObj = Selection.Find(What:="Hazard", LookIn:=xlValues, MatchCase:=True)

Do Until (RangeObj Is Nothing)
    iRow = RangeObj.Row
    Rows(iRow & ":" & iRow).Delete
    Columns("F:F").Select
    Set RangeObj = Selection.Find(What:="Hazard", LookIn:=xlValues, MatchCase:=True)
Loop

Application.ScreenUpdating = True

请试一试。

Answer 2

此解决方案对于小型数据集来说并不快，但对于非常大的数据集来说会更快。代码看起来更长，但处理数组比操作工作簿快得多。（我相信有更有效的方法来缩短数组）。顺便说一句 - 你的代码在我放在一起的示例数据集上对我有用。如果这对您的数据不起作用，请post一个您输入的小例子以及结果应该是什么样子。

示例输入：

宏的输出：

使用数组的宏代码：

Option Explicit

Sub dataCleanse2()
Dim nRows As Long, nCols As Long
Dim i As Long, j As Long, k As Long
Dim myRng As Range
Dim myArr() As Variant, myTmpArr() As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set myRng = Sheets("Sheet1").UsedRange
myArr = myRng.Value2

nRows = UBound(myArr, 1)
nCols = UBound(myArr, 2)
For i = nRows To 1 Step -1
    If CStr(myArr(i, 6)) = "Hazard" Then
        ReDim Preserve myTmpArr(1 To nRows - 1, 1 To nCols)
        For j = 1 To i - 1
            For k = 1 To nCols
                myTmpArr(j, k) = myArr(j, k)
            Next k
        Next j
        For j = i To nRows - 1
            For k = 1 To nCols
                myTmpArr(j, k) = myArr(j + 1, k)
            Next k
        Next j
        nRows = UBound(myTmpArr, 1)
        Erase myArr
        myArr = myTmpArr
        Erase myTmpArr
    End If
Next i

myRng.Clear
Set myRng = Sheets("Sheet1").Range(Cells(1, 1), Cells(nRows, nCols))
myRng.Value2 = myArr

Set myRng = Nothing
Erase myArr

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Answer 3

您可以采用以下 Autofilter 方法

Option Explicit

Sub dataCleanse()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

With ActiveSheet
    ' insert "dummy" header cell for Autofilter to work
    .Range("F1").Insert
    .Range("F1").value = "header"

    With .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
        .AutoFilter Field:=1, Criteria1:="Hazard"
        With .Offset(1).Resize(.Rows.Count - 1)
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        .AutoFilter
    End With

    .Range("F1").Delete 'remove "dummy" header cell

End With

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

处理 250 列的 10,000 条记录，每条记录不到一秒

Answer 4

感谢大家的帮助！我选择了另一种方法（除了一个用户发布的方法），它使用了一个数组。我仍然在熟悉数组（对 VBA / 一般编程来说是新手），但发现当我将值加载到数组中时，速度提高了大约 50%！我不知道为什么加载到数组中要快得多的确切原因，但我假设这是因为它将数组作为聚合而不是单个单元格值进行处理。

Sub CleanseAction()
Dim Last
Dim prevCalcMode As Variant

Application.ScreenUpdating = False
prevCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

Last = Cells(Rows.Count, "H").End(xlUp).Row
For i = Last To 1 Step -1
    If (Cells(i, "H").Value) = "Hazard" Then
           Cells(i, "A").EntireRow.Delete
    End If
Next i

Application.Calculation = prevCalcMode
Application.ScreenUpdating = True

提高 For 循环效率 VBA

Improving For Loop Efficiency VBA

excel

vba

excel-2013