在 Excel 中另存为时缓慢增加保存时间

Question

好的，Stack Overflow，据我所知，这个太棒了。

我创建了一个启用宏的 Excel 文件，该文件在运行时执行以下操作（高级）：

1. 用户通过文件对话框选择模板文件（它本身已启用宏）
2. 用户也可以通过文件对话框选择数据文件（未启用宏）
3. 宏逐个遍历数据文件，并逐个打开它们，格式化数据，将数据迁移到中间工作簿中的新工作表中，然后关闭数据文件而不保存它
4. 循环完所有文件后，中间工作簿也会保存，但保持打开状态
5. 循环完所有数据文件后，循环遍历中间工作簿的每张工作表，将当前工作表中的数据转移到模板文件中，并将模板文件另存为一个新的、唯一标记的文件。此包含现在数据的文件中的一行数据被复制到摘要表中

（比这要复杂一些，但据我所知，这些是重要的方面）

这就是问题所在；被选择的数据文件数以千计（到目前为止，我们尝试的最大运行是 4000 个文件）。随着宏的进行，保存这些文件所需的时间会缓慢但稳定地变长。它从大约五秒钟开始，但到最后一些文件需要大约五分钟才能保存。

我唯一的线索是我添加了一个迭代功能，一旦所有数据文件循环通过，它就会完全关闭模板文件并打开一个具有不同设置的新实例，并且然后重新开始该过程。这会导致保存时间恢复正常，然后再次开始增长。在此步骤中还会保存并关闭摘要文件，并为新的迭代打开一个新文件。

我考虑过每隔一百个左右的数据文件就关闭和重新打开模板文件，如果必须的话，我会实施，但我宁愿找到一个适当的解决方案来解决这个问题，而不是创可贴的方法。如果我每次都打开和关闭模板文件，我可以避免时间问题，但随后宏变得非常不稳定，在运行过程中它有时会在完全随机的点崩溃（但只是有时）。

这是在与互联网或任何类型的网络隔离并保存到固态驱动器的计算机上（我们已尝试控制很多变量）。

无论如何，我很困惑，所以欢迎任何建议！

Option Explicit

Public Sub Example()
    Dim Trial As Integer, Trials As Integer, DataSet As Integer
    Dim TrialChecker As Boolean
    Dim StartTime As Double, WaitTime As Double
    Dim StartDate As Date
    Dim FileSaveName As String
    Dim CopiedDataRange As Range
    Dim SummaryRunTimes As Worksheet, Calcs As Worksheet, CutoffsShifts As Worksheet
    Dim SheetObjects() As Worksheet
    Dim IntermediaryWorkbook As Workbook, Summary As Workbook, Template As Workbook

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'The 1 and Trials are actually set by Lbound and Ubound funcitons, but the premise is the same
    For Trial = 1 To Trials
        Workbooks.Add
        Set Summary = ActiveWorkbook
        'I use this one sheet to keep track of how long different parts of the code take to run
        Set SummaryRunTimes = Summary.Worksheets(1)
        SummaryRunTimes.Name = "Run Times"
        SummaryRunTimes.Cells(1, 1).Value = "ID"
        SummaryRunTimes.Cells(1, 2).Value = "Data Copy Time (s)"
        SummaryRunTimes.Cells(1, 3).Value = "Formula Copy and Calc Time (s)"
        SummaryRunTimes.Cells(1, 4).Value = "Summary Copy Time (s)"
        SummaryRunTimes.Cells(1, 5).Value = "Save and Cleanup Time (s)"

        'sheetnames is defined elsewhere in the code (it's a global variable right now. I intend to change that later).
        'It's simply an array of strings with six elements.
        For Counter = LBound(sheetnames) To UBound(sheetnames)
            Summary.Worksheets.Add
            Summary.ActiveSheet.Name = sheetnames(Counter)
        Next Counter

        'Again, TemplateLocation is defined elsewhere. It's just a string grabbed from a filedialog
        Workbooks.Open (TemplateLocation)
        Set Template = ActiveWorkbook
        Set Calcs = Template.Sheets("Calcs")
        Set CutoffsShifts = Template.Sheets("Log Cutoffs & Shifts")

        'SheetObjects is simply used as a convenient reference for various sheets in the template file. I found
        'it cleaned up the code a bit. Some might say it's unnecessary.
        For Counter = LBound(sheetnames) To UBound(sheetnames)
            Set SheetObjects(Counter) = Template.Sheets(sheetnames(Counter))
        Next Counter

        'This is where the parameters for the given trial are set in the template file. Trialchecker is set elsewhere
        '(it checks a yes/no dropdown in the original spreadsheet). ParameterAddresses is a range that's grabbed from a
        'table object in the original spreadsheet and contains where these parameters go in the template file. These
        'will not change depending on the trial, thus column = 1. TrialParameters is in the same table, and are the
        'parameters themselves. These DO depend on the trial, and thus the column is equal to the trial number
        If TrialChecker = True Then
            For Counter = LBound(ParameterAddresses) To UBound(ParameterAddresses)
                CutoffsShifts.Range(ParameterAddresses(Counter, 1)).Value = TrialParameters(Counter, Trial)
            Next Counter
        End If

        For DataSet = 1 To IntermediaryWorkbook.Worksheets.Count - 1
            'This is where I start my timers
            StartTime = Timer
            StartDate = Date

            'This is where the data is actually copied from the intermediary file into the template. It's always five
            'columns wide, but can be any number of rows. the SummaryRunTimes statement is merely grabbing the unique
            'identifier of that given worksheet
            With IntermediaryWorkbook
                Set CopiedDataRange = Calcs.Range("$A$3:$E$" & .Worksheets(Counter).UsedRange.Rows.Count + 1)
                CopiedDataRange.Value = IntermediaryWorkbook.Worksheets(Counter).Range("$A$2:$E$" & .Worksheets(Counter).UsedRange.Rows.Count).Value
                SummaryRunTimes.Cells(Counter + 1, 1) = Calcs.Cells(3, 1).Value
            End With

            'First timestamp
            SummaryRunTimes.Cells(Counter + 1, 2) = CStr(Round(86400 * (Date - StartDate) + Timer - StartTime, 1))
            StartTime = Timer
            StartDate = Date

            'This statement copies down the formulas that go with the data (which is aobut 100 columsn worth of formuals).
            'Throughout this process, calculation is set to manual, so calculation is manually triggered here (Don't ask
            'me why I do it twice. If I recall, it's because pivot tables are weird)
            Set CopiedFormulaRange = Calcs.Range("$F$3:$KL$" & Calcs.UsedRange.Rows.Count)
            CopiedFormulaRange.FillDown
            Application.Calculate
            Template.RefreshAll
            Application.Calculate

            'Second timestamp
            SummaryRunTimes.Cells(Counter + 1, 3) = CStr(Round(86400 * (Date - StartDate) + Timer - StartTime, 1))
            StartTime = Timer
            StartDate = Date

            'This is a separate function that copies data from the template file into the summary sheet.
            'I know you can't see the code, but just know that it only copies six sets of seven cells, so
            'as far as I can tell, it's not what is causing the problem. The timestamp supports this idea, as
            'it's consistent and short
            Call SummaryPopulate(Summary, sheetnames, SheetObjects, r)
            r = r + 1

            'Third timestamp
            SummaryRunTimes.Cells(Counter + 1, 4) = CStr(Round(86400 * (Date - StartDate) + Timer - StartTime, 1))
            StartTime = Timer
            StartDate = Date

            'These following few lines are meant to save the template file as a new file. As I mentioned, this is where
            'things get bogged down. FileNameSuffix is a string set via a InputBox. TrialNames is set via the table object
            'mentioned above, and is an array of strings.
            Application.DisplayAlerts = False

            If TrialChecker = True Then
                FileSaveName = FolderLocation & "\" & Replace(Calcs.Cells(3, 1).Value, "/", " ") & " OOIP " & FileNameSuffix & " - " & TrialNames(1, Trial) & ".xlsm"
            Else
                FileSaveName = FolderLocation & "\" & Replace(Calcs.Cells(3, 1).Value, "/", " ") & " OOIP " & FileNameSuffix & ".xlsm"
            End If

            Template.SaveAs Filename:=FileSaveName, ConflictResolution:=xlLocalSessionChanges

            Application.DisplayAlerts = True

            'This part clears the copied data and formulas. I added the two Set Nothing lines in the hopes that it would
            'solve my problem, but it doesn't seem to do anything
            CopiedDataRange.ClearContents
            CopiedDataRange.Offset(1, 0).Rows.Delete
            Set CopiedDataRange = Nothing
            Set CopiedFormulaRange = Nothing

            'Fourth and final timestamp
            SummaryRunTimes.Cells(Counter + 1, 5) = CStr(Round(86400 * (Date - StartDate) + Timer - StartTime, 1))

            'It seems to run a bit better if there's this Wait line here, but I'm not sure why. The WaitTime
            'is grabbed from the original worksheet, and is a Double
            Application.Wait (TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + WaitTime))

        Next DataSet

        'This but simply saves the summary file and then closes that and the template file. Then the process starts anew.
        'This seems to be the key for resetting something that reduces the run times.
        If TrialChecker = True Then
            Summary.SaveAs Filename:=FolderLocation & "\" & "OOIP Summary " & FileNameSuffix & " - " & TrialNames(1, Trial) & ".xlsx"
        Else
            Summary.SaveAs Filename:=FolderLocation & "\" & "OOIP Summary " & FileNameSuffix & ".xlsx"
        End If
        Template.Close False
        Summary.Close False
    Next Trial

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    IntermediaryWorkbook.Close False
End Sub

Answer 1

很抱歉将其发布为答案，但事实并非如此，但我在这里需要一点空间。 我浏览了您的代码，发现没有定义 IntermediateWorkbook 并决定定义它不会有任何区别。我确信您已经完成了我可能想做的所有事情，并且我对您的代码的研究不会发现您尚未发现的任何内容。因此，我寻找一种解决方案，首先将流程分开，然后以不同的方式将它们重新连接起来——或者可能不是。这是我的“解决方案”的关键：如果部件不能连接，让它们单独运行。因此任务 我设置的是创建单独的部分。

第 1 部分 这在您的第 2 到第 4 点中进行了描述，即创建中级工作簿。您还没有说明为什么用户必须在创建该工作簿之前选择一个模板，但如果这有一些影响，则可以打开和关闭该模板。我建议的重要部分是在保存中间工作簿时结束该过程。关闭它。关闭模板。项目已经完成 - 第 1 部分。

第 2 部分 打开中间文件并遍历其数据，创建新文件。这些文件中的每一个都基于一个模板。如果有多个表单可供选择并且中间工作簿中的数据不支持自动选择，您可能必须提供代码以启用正确模板的选择。 在此过程中，您一次只能打开中间工作簿和一个新文件。 在创建新文件之前，每个文件都会关闭。 在此过程结束时，中间文件也将关闭。 （顺便说一句，我发现您对模板的处理可能是您的问题的原因。在我的过程描述中，模板从未打开过。相反，新的工作簿是基于它创建的，这就是发明者的设计。）

第 3 部分 创建或打开摘要文件。打开每个新创建的工作簿并将一行复制到摘要中。然后关闭每个工作簿并打开下一个。 在流程结束时关闭摘要工作簿。

加入零件： 坦率地说，我会尝试从一开始就将第 3 部分整合到第 2 部分中。我不相信打开一个额外的工作簿会有所作为。但如果确实如此，则拆分任务。

您的两个或三个单独的过程可能应该在一个加载项或一个除了保存代码之外什么都不做的工作簿中（向另外两个或三个其他工作簿添加一个打开的工作簿 - Excel 可以轻松处理）。向本工作簿中的代码添加一个 sub，它依次调用两个或三个 proc，一个接一个。

在此程序结构中，您的问题可能会在第 2 部分中重新出现，因为保存每个新工作簿可能需要更多时间。如果发生这种情况，问题的性质将会发生变化，应该更容易理解，并且希望更容易解决。