优化Excel VBA代码 [英] Optimize Excel VBA Code
问题描述
Sub RemovePageHeaders()
Application.ScreenUpdating = False
Dim objRange As范围
设置objRange = Cells.Find(HeaderText)
虽然objRange<>
objRange.Offset(1,0).Rows(1).EntireRow.Delete
objRange.Rows(1).EntireRow.Delete
设置objRange = Cells.Find(HeaderText )
Wend
MsgBox(我完成删除页眉!
End Sub
提前感谢!
尝试以下子句。它从最底层的行循环到顶部,检查列3为HeaderText。如果找到,它会删除该行和下面的行。在具有2GB内存的C2D E8500上,每100,000行中每100万行就需要超过一分钟。
Sub RemoveHeaders()
Dim i As Long
Application.ScreenUpdating = False
Debug.PrintStarted:&现在
对于i = ActiveSheet.UsedRange.Rows.Count到1步-1
如果ActiveSheet.Cells(i,3)=HeaderText然后
ActiveSheet.Range(我和& :& i + 1).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
Debug.PrintFinished:&现在
End Sub
编辑
对于稍微有点犹太人区,但可能要快得多的解决方案尝试这样:
- 将下面的代码中的常量更改为每一个空白的第一列的编号行。例如,如果您的数据占用A-F列,则希望常数为7(G列)。
- 运行代码,将每行输入行号。应该需要30秒左右。
- 按照C列对ENTIRE数据进行排序;
- 可视化查找HeaderText,选择并删除所有行。
- 按行编号列排序(在我的例子中为G)。
-
删除行号列(在我的示例中再次显示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.Printdone
结束子
I have the following VBA code within excel. It's goal is to remove a row if the given text is found, as well as remove the row directly below it. It needs to scan roughly 700k rows and is taking roughly an hour to do 100k rows. Does anyone see any optimization?
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
Thanks in advance!
Try the following sub. It loops from the bottomm-most row to the top, checking column 3 for "HeaderText". If that's found, it delete the row and the one below it. On a C2D E8500 with 2 gigs of RAM it takes just over a minute per 100,000 rows on a sheet with 1 million rows.
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
EDIT For a slightly ghetto but possibly much faster solution try this:
- Change the constant in the below code to the number of the first column that's blank in every row. For example if your data takes up columns A-F, you want the constant to be 7 (column G).
- Run the code, it will put the row number next to every entry. Should take around 30 seconds.
- Sort the ENTIRE data by column C; this should take less than a minute.
- Find "HeaderText" visually, select and delete all the rows.
- Sort by your row-numbered column ("G" in my example).
Delete the row-numbered column (again, "G" in my example).
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"
End Sub
这篇关于优化Excel VBA代码的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!