vba - 加速 Excel 宏作为打开

Question

所以这个 Excel 文件的全部范围 就是将其他27个外部文件中的一个一个复制粘贴到当前的Excel文件中。 为了说明我的意思，以下是代码示例和受刺激的捕获图片。

宏(行＃包括空格线):

1. 导入子

在我的文件中，我有 27 个这样的潜艇。它比这个例子更长。我真正的宏总共有 179 行。在这个例子中，它只有 51 行。

唯一会改变的是行号作为第 6 行 VBA 代码中的单词行。

    Sub Import_NJ()

    Dim Row As Integer, PathFileOpen As String, NameFileOpen As String, 
    TypeFileOpen As String, FullFileName As String, TabCopy As String, ModelFileName As String

    Let Row = Worksheets("Control_Table").Cells("2", "D").Value
    Let PathFileOpen = Worksheets("Control_Table").Cells(Row, "A").Text
    Let NameFileOpen = Worksheets("Control_Table").Cells(Row, "B").Text
    Let TypeFileOpen = Worksheets("Control_Table").Cells(Row, "C").Text
    Let FullFileName = PathFileOpen & "\" & NameFileOpen & TypeFileOpen
    Let TabCopy = Worksheets("Control_Table").Cells(Row, "J").Text
    Let ModelFileName = Worksheets("Control_Table").Cells("10", "B").Text

        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
        Application.Calculation = xlCalculationManual
        Workbooks.Open FileName:=FullFileName, UpdateLinks:=0

    'Copy Income Statement
        Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("9", "C").Resize(5, 120).Copy         'Revenues
        Workbooks(ModelFileName).Worksheets(TabCopy).Cells("4", "AW").Resize(5, 120).PasteSpecial xlPasteValues
        Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("18", "C").Resize(4, 120).Copy        'Prod Costs
        Workbooks(ModelFileName).Worksheets(TabCopy).Cells("11", "AW").Resize(4, 120).PasteSpecial xlPasteValues
        Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("25", "C").Resize(26, 120).Copy       'Employee Related thru maintenance
        Workbooks(ModelFileName).Worksheets(TabCopy).Cells("17", "AW").Resize(26, 120).PasteSpecial xlPasteValues
        Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("53", "C").Resize(3, 120).Copy       'D&A
        Workbooks(ModelFileName).Worksheets(TabCopy).Cells("46", "AW").Resize(3, 120).PasteSpecial xlPasteValues



        Application.CutCopyMode = False
        Workbooks(NameFileOpen).Close
        Application.DisplayAlerts = True

    End Sub

批量导入子

虽然它只显示 7 个调用，但我的文件中有 27 个调用

    Sub batch_import()
    With Application

        Call Import_NJ   
        Call Import_MD 
        Call Import_PA   
        Call Import_OKC 
        Call Import_CA    
        Call Import_HI 
        Call Import_IN    

    End With

        Application.Calculation = xlCalculationAutomatic
        ActiveWorkbook.Save
        Application.DisplayAlerts = True

        MsgBox _
        ("Batch loading Completed.")

    End Sub

我尝试了什么:

正如您在第一个示例宏中看到的那样，关闭每个 Sub 中的自动计算。以及其他尽可能多的应用程序。

我没有关闭屏幕更新，因为我的经理想看到它。

我在 Patch sub 的末尾激活了自动计算。

我猜重新赛季减慢了整个过程是因为我的模块中有超过 27 个潜艇。此外，工作表中填写了一堆公式。

有什么方法可以加快宏打开文件和运行它的速度吗？如果我需要详细说明这个问题，请告诉我。提前感谢您并通读我的问题。 :)

Answer 1

您只是在粘贴值；而是直接传输值并从考虑中删除剪贴板。可以在 With ... End With 中引用源或目标。

这个，

    Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("9", "C").Resize(5, 120).Copy         'Revenues
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("4", "AW").Resize(5, 120).PasteSpecial xlPasteValues
    Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("18", "C").Resize(4, 120).Copy        'Prod Costs
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("11", "AW").Resize(4, 120).PasteSpecial xlPasteValues
    Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("25", "C").Resize(26, 120).Copy       'Employee Related thru maintenance
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("17", "AW").Resize(26, 120).PasteSpecial xlPasteValues
    Workbooks(NameFileOpen).Worksheets("Total_Reports").Cells("53", "C").Resize(3, 120).Copy       'D&A
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("46", "AW").Resize(3, 120).PasteSpecial xlPasteValues

变成，

With Workbooks(NameFileOpen).Worksheets("Total_Reports")
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("4", "AW").Resize(5, 120) = _
        .Cells("9", "C").Resize(5, 120).Value2         'Revenues
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("11", "AW").Resize(4, 120) = _
        .Cells("18", "C").Resize(4, 120).Value2        'Prod Costs
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("17", "AW").Resize(26, 120) = _
        .Cells("25", "C").Resize(26, 120).Value2       'Employee Related thru maintenance
    Workbooks(ModelFileName).Worksheets(TabCopy).Cells("46", "AW") = _
        .Cells("53", "C").Resize(3, 120).Value2        'D&A
End With

如评论中所述，如果外部文件位于或超过 1Mb 文件大小区域，请将它们另存为 .XLSB(excel 二进制文件)以减少加载时间。