优化Excel VBA代码 [英] Optimize Excel VBA Code

问题描述

我在excel中有以下VBA代码。目的是删除一行，如果找到给定的文本，以及删除它下面的行。它需要扫描大约700k行，大概需要一个小时才能做100k行。有没有人看到任何优化？

  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 
  

编辑
对于稍微有点犹太人区，但可能要快得多的解决方案尝试这样：

1. 将下面的代码中的常量更改为每一个空白的第一列的编号行。例如，如果您的数据占用A-F列，则希望常数为7（G列）。


2. 运行代码，将每行输入行号。应该需要30秒左右。


3. 按照C列对ENTIRE数据进行排序;


4. 可视化查找HeaderText，选择并删除所有行。


5. 按行编号列排序（在我的例子中为G）。



6. 删除行号列（在我的示例中再次显示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:

1. 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).
2. Run the code, it will put the row number next to every entry. Should take around 30 seconds.
3. Sort the ENTIRE data by column C; this should take less than a minute.
4. Find "HeaderText" visually, select and delete all the rows.
5. Sort by your row-numbered column ("G" in my example).

6. 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屋！