使用双循环在VBA excelmacros中加快运行时间

我实际上有一些工作代码，虽然我有大量的数据和编写代码的方式，但运行需要一个多小时，而且我仍然需要添加相当多的代码才能真正分析数据。 我正在使用一个双循环，并且在我添加screenupdating = false之前，它似乎嵌套在内部的循环是什么花了这么长时间。

这是我有：

Sub LReview() Dim SecX As Workbook, LipR As Workbook Dim ws As Worksheet, Xws As Worksheet, Fsheet As Worksheet Dim i As Long, XwsRows As Long Path = ThisWorkbook.Path & "\" Set LipR = ThisWorkbook Set SecX = Application.Workbooks.Open(Path & "SecurityXtract_Mnthly.csv") Windows("SecurityXtract_Mnthly.CSV").Activate Set Xws = Sheets("SecurityXtract_Mnthly") With Xws XwsRows = .Range("B" & .Rows.Count).End(xlUp).Row End With Windows("LMacro.xlsm").Activate Sheets.Add.Name = "Funds" Set ws = Sheets("Funds") Windows("SecurityXtract_Mnthly.CSV").Activate Columns("B:B").Select Selection.Copy Windows("LMacro.xlsm").Activate ws.Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Range("$A$1:$A$60000").RemoveDuplicates Columns:=1, Header:= _ xlNo Application.DisplayAlerts = False Application.ScreenUpdating = False With ws 'Change back to 100+ For i = 2 To 5 If ws.Range("A" & i).Value <> "" Then Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ws.Range("A" & i).Value Set Fsheet = ActiveSheet Range("A1").Value = "Fund:" Range("B1").Value = Fsheet.Name Range("A2").Value = "Date:" Range("B2").Value = "=Xtract!R[-1]C" Windows("SecurityXtract_Mnthly.CSV").Activate Rows("1:1").Select Selection.Copy Windows("LMacro.xlsm").Activate Rows("4:4").Select ActiveSheet.Paste Selection.Font.Bold = True Application.CutCopyMode = False For j = 2 To XwsRows If Xws.Range("B" & j).Value = Fsheet.Range("B1") Then Windows("SecurityXtract_Mnthly.CSV").Activate Xws.Range("B" & j).Select ActiveCell.EntireRow.Select Selection.Copy Windows("LMacro.xlsm").Activate Fsheet.Range("A" & j + 3).EntireRow.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("A:A").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.EntireRow.Delete End If Next j Range("C:D, F:F, I:BB, BD:BL, BP:BR, BT:BV, BX:CD, CF:CN, CP:DI").EntireColumn.Select Selection.Delete Shift:=xlToLeft End If Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Next i End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

我还在另一个问题上发现了这个代码，但是我不知道是否可以应用这个代码，因为我使用了两个不同的工作簿。 此代码：

  If Range("S1").Offset(i) > 0.005 Then Range("AC").Offset(i).Resize(1, 2).Value = Range("Z").Offset(i).Resize(1, 2).Value End If 

取代这个：

 If Range("S" & i) > 0.005 Then Range("Z" & i, "AA" & i).Copy Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues End If 

我在这里引用的代码/问题的完整链接是： 关于如何加快循环的build议

预先感谢您的任何帮助可以给:)

Answer 1

查看Excel博客上的链接

从我的代码中看到的文章的关键要点：

1. 避免select/激活对象 – 在大多数情况下，可以直接引用单元格或范围。

   例如，而不是使用

    ActiveCell.EntireRow.Select Selection.Copy 

   您可以使用

    ActiveCell.EntireRow.Copy 

2. 在代码运行的时候，closures所有的东西，但是必要的东西 – 即使你的电子表格中没有大量的计算，我也注意到使用

   Application.Calculation = xlCalculationManual

   在代码的开始，然后在最后，将其设置回（例如）…

   Application.Calculation = xlCalculationAutomatic

看看其他一些技巧和例子。 希望有所帮助。

Answer 2

如果跑了一个多小时，而且能够削减75％，跑起来还是需要很长时间！ 如果您仍然对改进感兴趣，我只想分享一下避免计算延迟的好方法。 我有这样的结果，现在我一直在使用它。

简而言之，Excel需要很长时间在“VBA世界”和“电子表格世界”之间来回复制数据。

如果你一次完成所有的“读”，处理，然后一次完成所有的“写”，你会得到惊人的performance。 这是使用不同的数组完成的，如下所述：

http://msdn.microsoft.com/en-us/library/ff726673.aspx#xlFasterVBA

在标有“在单个操作中读取和写入大块数据”的部分中

我能够重构我花了5分钟运行的一些代码，并将其降低到1.5分钟。 重构花了我10分钟，这是惊人的，因为它是相当复杂的代码。