我创建了一个启用宏的Excel文件，该文件执行以下操作（高级）：
1.用户通过文件对话框选择模板文件（本身启用宏）
1.用户也通过文件对话框选择数据文件（未启用宏）
1.宏将遍历数据文件，并逐个打开它们，设置数据格式，将数据迁移到中间工作簿中的新工作表，然后关闭数据文件而不保存它
1.循环通过所有文件后，中间工作簿也将保存，但保持打开状态
1.循环通过所有数据文件后，将循环通过中间工作簿的每个工作表，将当前工作表中的数据传输到模板文件，并将模板文件另存为具有唯一标签的新文件。此现在包含数据的文件中的一行数据将复制到摘要工作表中
选择的数据文件数量达数千个（到目前为止，我们尝试的最大运行是4000个文件）。随着宏的运行，保存这些文件所需的时间缓慢但稳定地变长。开始时大约为5秒，但到最后，一些文件需要大约5分钟才能保存。
我添加了一个迭代特性，一旦所有数据文件都被循环通过，它就完全关闭模板文件，并使用不同的设置打开它的一个新示例，然后重新开始这个过程。
这将使保存时间恢复正常。
在此步骤中，还将保存并关闭摘要文件，并为新的小版本打开一个新文件。
我曾考虑过每隔一百个左右的数据文件就关闭并重新打开模板文件，但我更希望得到一个适当的解决方案。
如果我每次都打开和关闭模板文件，我就避免了时间问题，但是宏会变得非常不稳定，有时会在随机点崩溃。
这是在一台与互联网或任何类型的网络隔离的计算机上，并保存到固态驱动器（我们试图控制相当多的变量）。

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