提高循环效率VBA

目前我有10Kx15行价值的原始数据导入Excel电子表格。 我有一些被清理的领域，但有兴趣的领域是一个叫做“危险”的领域。 对于遇到的每一个危害事件，我们都需要将其解决。

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

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条logging，需要10-15秒。 我已经尝试过使用自动filter，但是当我使用.EntireRow.Delete时，会去除过滤条件下的行。 即如果我们有第1行和第3行的“危险”并使用自动filter，它也会删除没有“危险”的行2。

我也将计算设置为手动，然后自动，所以它不会每次刷新。

有没有什么build议可以提高我的macros的速度？

谢谢！

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 

每秒处理10000个logging，每个logging小于一秒钟

Answer 2

我不知道这是否会更快，但我的build议是select列F，find“危险”的实例，删除该行，并重复该过程，直到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 3

这个解决scheme对于小数据集来说不会更快，但是对于非常大的数据集来说， 代码看起来更长，但处理数组比处理工作簿要快得多。 （我相信有更有效的方法来缩短arrays）。 顺便说一句 – 你的代码在我放在一起的示例数据集上工作。 如果这对您的数据不起作用，请发布您的input的一个小例子，结果应该是什么样子。

示例input：

macros输出：

使用数组的macros代码：

 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