优化Excel VBA代码
我在Excel中有以下的VBA代码。 它的目标是如果find给定的文本，删除行，以及删除直接下面的行。 它需要扫描大约700k行，并且需要大约一个小时才能完成10万行。 有没有人看到任何优化？
Sub RemovePageHeaders() Application.ScreenUpdating = False Dim objRange As Range Set objRange = Cells.Find("HeaderText") While objRange <> "" objRange.Offset(1, 0).Rows(1).EntireRow.Delete objRange.Rows(1).EntireRow.Delete Set objRange = Cells.Find("HeaderText") Wend MsgBox ("I'm done removing page headers!") End Sub 提前致谢！
尝试下面的子。 它从最下面一行循环到最上面，检查第3列“HeaderText”。 如果find了，它会删除该行和下面的行。 在具有2个RAM的C2D E8500上，在100万行的纸张上，每100,000行只需要一分钟以上。
Sub RemoveHeaders() Dim i As Long Application.ScreenUpdating = False Debug.Print "Started: " & Now For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If ActiveSheet.Cells(i, 3) = "HeaderText" Then ActiveSheet.Range(i & ":" & i + 1).EntireRow.Delete End If Next i Application.ScreenUpdating = True Debug.Print "Finished: " & Now End Sub
编辑对于一个略有贫民窟，但可能更快的解决scheme试试这个：
- 将下面的代码中的常量更改为每行中空白的第一列的编号。 例如，如果您的数据占用了列AF，您希望该常数为7（列G）。
- 运行代码，它将把行号放在每个条目的旁边。 应该需要大约30秒。
- 按列C对整个数据进行sorting; 这应该不到一分钟。
- 直观地查找“HeaderText”，select并删除所有行。
- 按行编号列（在我的例子中是“G”）sorting。
-
删除行号列（在我的例子中再次是“G”）。
Sub NumberColumns() Const BLANK_COLUMN = 7 Dim i As Long For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 ActiveSheet.Cells(i, BLANK_COLUMN) = i Next i Debug.Print "done"结束小组
即使没有完全回答这个问题，也可以帮助任何读者
网上有几个关于优化vba的提示。 特别是，你可以这样做：
'turn off some Excel functionality so your code runs faster 'these two are especially very efficient Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'use these if you really need to Application.DisplayStatusBar = False Application.EnableEvents = False 'is very efficient if you have ANY event associated with what your macro is going to do 'code goes here 'at the end, don't forget to restore the default behavior 'calculate the formulas Application.Calculate Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayStatusBar = True Application.EnableEvents = True
在这里看到更多的信息
把这个条目稍晚一点。 它应该比接受的解决scheme快大约2倍。 我使用我的XP Excel 2003计算机1演出计算出来。
Sub DeleteHeaderText() Dim bUnion As Boolean Dim d1 As Double Dim l As Long Dim rDelete As Range Dim wks As Worksheet Dim vData As Variant d1 = Timer Application.EnableEvents = False Application.ScreenUpdating = False bUnion = False Set wks = ActiveSheet lEnd = ActiveSheet.UsedRange.Rows.Count vData = wks.Range("C1:C" & lEnd).Value2 For l = 1 To lEnd If vData(l, 1) = "HeaderText" Then If bUnion Then Set rDelete = Union(rDelete, wks.Range("A" & l, "A" & l + 1)) Else Set rDelete = wks.Range("A" & l, "A" & l + 1) bUnion = True End If l = l + 1 End If Next l Debug.Print Timer() - d1 rDelete.EntireRow.Delete Debug.Print Timer() - d1 End Sub
我知道这是迟到，但如果我理解你的问题，那么你删除基于C列中的“HeaderText”的行。所以，因为我没有看你的数据，我创build了我自己的。 我创build了700,000行，每第9行包含“HeaderText”string。 它删除了〜233k行（“HeaderText”行+行之前+行后），并在我的电脑上运行2.2秒。 试一试！！
Private Declare Function timeGetTime Lib "winmm.dll" () As Long Sub DeleteHeaders() Dim LastRow As Long Dim I As Long Dim WkSheet As Excel.Worksheet Dim VArray As Variant Dim NewArray() As String Dim BooleanArray() As Boolean Dim NewArrayCount As Long Dim J As Long Dim T As Double Dim DeleteRowCount As Long T = timeGetTime With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With Set WkSheet = ThisWorkbook.Sheets("Sheet1") With WkSheet.UsedRange LastRow = .Rows.Count VArray = .Value End With ReDim BooleanArray(0 To UBound(VArray, 1) - 1), NewArray(UBound(VArray, 1) - 1, 0 To UBound(VArray, 2)) For I = 1 To UBound(VArray, 1) If InStrB(1, VArray(I, 3), "HeaderText", vbBinaryCompare) <> 0 Then BooleanArray(I - 1) = Not BooleanArray(I - 1) BooleanArray(I) = Not BooleanArray(I) BooleanArray(I + 1) = Not BooleanArray(I + 1) End If Next I For I = LBound(BooleanArray, 1) To UBound(BooleanArray, 1) If BooleanArray(I) = False Then For J = LBound(VArray, 2) To UBound(VArray, 2) NewArray(NewArrayCount, J - 1) = VArray(I + 1, J) Next J NewArrayCount = NewArrayCount + 1 Else DeleteRowCount = DeleteRowCount + 1 End If Next I With WkSheet .Cells.Delete .Range("a1:c" & NewArrayCount).Value = NewArray End With With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With Erase NewArray, BooleanArray, VArray MsgBox "Deleted " & DeleteRowCount & " rows." & vbNewLine & vbNewLine & _ "Run time: " & Round((timeGetTime - T) / 1000, 3) & " seconds.", vbOKOnly, "RunTime" End Sub
这里有一个解决scheme，将在大约5-20秒内运行在10万行，取决于你有多less“HeaderText”的发生。 按照你的要求，它将删除C列中的HeaderText以及它上面的行。
更新 ：正如已经指出的那样，这对于大约10万个较小的数据集合起作用，但是在更大的集合上它实际上并不是这样。 回到绘图板 ：）
Sub DeleteHeaders() Application.ScreenUpdating = False Dim lastRow As Long Dim varray As Variant lastRow = Range("C" & Rows.Count).End(xlUp).Row On Error Resume Next varray = Range("C1:C" & lastRow).Value For i = UBound(varray, 1) To 1 Step -1 If varray(i, 1) = "HeaderText" Then Range("C" & i - 1, Range("C" & i)).EntireRow.Delete i = i - 1 End If Next Application.ScreenUpdating = True End Sub
工作原理 ：通过将整个C列转储到一个variables数组中并在Excel中进行工作，可以大大提高速度。 （1，1），（2，1），（3，1），第一个数字是行号，所以你所要做的就是循环向后。 关键是确保同时删除两行，并减less一个我。
以下是从Bill Jelen书中解除的代码，对于这个目的来说太棒了。
使用一个列（列A为我的代码）与一些逻辑，以确定是否应该隐藏行不。
在该列的所有可用单元格中使用以下公式
=IF(test TRUE to hide, 1, "keep")
现在使用下面的VBA
Range("A1:A10000").SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow.Delete
这将一次select由公式返回的数字的所有行，这正是您要删除的行。 不需要循环！
在我的博客上有这样的脚本：
样本一 ：
Sub DelBlankRows() Range("D1:D" & Cells _ (Rows.Count,2).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub
样本二 ：
Sub DeleteRowsWithSpecifiedData() 'Looks in Column D and requires Column IV to be clean Columns(4).EntireColumn.Insert With Range("D1:D" & ActiveSheet.UsedRange.Rows.Count) .FormulaR1C1 = "=IF(RC[1]="""","""",IF(RC[1]=""Not Needed"",NA()))" .Value = .Value On Error Resume Next .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete End With On Error GoTo 0 Columns(4).EntireColumn.Delete End Sub