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

上的链接

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

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

例如，而不是使用
```
ActiveCell.EntireRow.Select
Selection.Copy
```
你可以使用
```
ActiveCell.EntireRow.Copy
```
在您的代码运行时关闭所有功能 - 即使您的计算中没有大量的计算电子表格，我注意到使用
时有所改进
Application.Calculation = xlCalculationManual

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

Application.Calculation = xlCalculationAutomatic

另请参阅其他一些提示和示例。希望有所帮助。

Answer 2

如果运行花了一个多小时，你能够减少75％，那么它仍然需要很长时间才能运行！如果您仍然对改进感兴趣，我只想分享一下避免计算延迟的好方法。我用这个得到了很棒的结果，现在我一直在使用它。

简而言之，Excel需要很长时间才能在＆＃34; VBA世界＆＃34;之间来回复制数据。和电子表格世界＆＃34;。

如果你做了所有＆＃34;读取＆＃34;立刻，处理，然后做所有＆＃34;写＆＃34;马上，你获得惊人的表现。这是使用此处记录的变体数组完成的：

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

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

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

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

2 个答案: