当在Excel中保存时，缓慢增加保存时间

Question

好的，堆栈溢出，据我所知，这是一个乏味的。

我已经创建了一个宏启用Excel文件，该运行时，执行以下操作（高电平）：通过文件对话框

用户

1. 用户选择模板文件（其本身是宏启用）通过文件对话框选择数据文件（不启用宏）
2. 宏步骤通过数据文件并逐个打开它们，格式化数据，将数据迁移到中间工作簿中的新工作表中，然后关闭数据文件不保存
3. 一旦所有文件都被循环使用，中间工作簿也会被保存，但保持打开状态
4. 一旦所有数据文件都被循环使用，每个中间工作簿都被循环，当前工作表中的数据被传送到模板文件，并将模板文件保存为一个新的，唯一标记的文件。在这种含现在数据文件中的一行数据被复制到一个汇总表

（这是比这更复杂一些，但这些都是很重要的方面，只要我可以告诉）

这是问题所在;正在选择的数据文件的数量是成千上万（到目前为止，我们尝试的最大运行量是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可以轻松处理）。在本工作手册中的代码中，添加一个依次调用两个或三个过程的子接口。

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