當在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部分中再次出現，因爲它可能需要逐步更多時間來保存每個新工作簿。如果發生這種情況，問題的性質將發生變化，應該更容易理解，並希望更容易解決。