使用双循环加快 VBA excel 宏中的运行时间

Question

我实际上有一些工作代码，虽然我拥有的数据量和我编写代码的方式需要一个多小时才能运行，而且我仍然需要添加相当多的代码来实际分析数据。我正在使用双循环，在我添加 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

我在此处引用的此代码/问题的完整链接是： Suggestions on how to speed up loop

提前感谢您提供的任何帮助:)

Answer 1

查看Excel Blog上的链接

我在您的代码中看到的文章的主要内容：

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

   例如，而不是使用

   ActiveCell.EntireRow.Select
   Selection.Copy
   

   你可以使用

   ActiveCell.EntireRow.Copy
   

2. 在代码运行时关闭除基本功能以外的所有内容 - 即使您的代码中没有大量计算 电子表格，我注意到使用时有所改进

   Application.Calculation = xlCalculationManual

   在代码的开头，然后在结尾，将其设置回 （例如）...

   Application.Calculation = xlCalculationAutomatic

还可以查看其他一些提示和示例。希望对您有所帮助。

Answer 2

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

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

如果您一次执行所有“读取”、处理，然后一次执行所有“写入”，您将获得惊人的性能。这是使用此处记录的变体数组完成的：

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

在标记为：在单个操作中读取和写入大块数据的部分中

我能够重构一些需要 5 分钟才能运行的代码，并将其缩短到 1.5 分钟。重构花了我 10 分钟，这太棒了，因为它是相当复杂的代码。