Question

目前，我在excel电子表格中导入了10Kx15行的原始数据。我有许多领域被清理但感兴趣的领域是一个名为“危险”的领域。对于遇到的每一个危险事件，我们都需要解决这个问题。

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

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'并使用自动过滤器，它也会删除没有'危险'的第2行。

我还先将计算设置为手动，然后设置为自动，因此每次都不刷新。

是否有任何建议可以提高我的宏的速度？

谢谢！

Answer 1

您可以使用以下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

处理10,000个250列的记录，每个记录远远少于一秒

Answer 2

我不确定这是否会更快，但我的建议是选择列F，找到“危险”的实例，删除该行，然后重复该过程，直到在F列中找不到“危险”。 / p>

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 3

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

示例输入：

宏的输出：

使用数组的宏代码：

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 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

提高环路效率VBA

4 个答案: