好吧，Stack Overflow，据我所知，这个是一个很糟糕的。
我创建了一个启用宏的excel文件，在运行时执行以下操作（高级别）：
（这有点复杂，但据我所知，这些是重要的方面）
这是问题;被选中的数据文件数量达到数千个（到目前为止，我们尝试的最大运行量是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
答案 0 :(得分：0)
很抱歉发布这个作为答案，但事实并非如此，但我需要一点空间。 我查看了你的代码，发现IntermediateWorkbook没有定义，并决定定义它不会有所作为。我确信你已经完成了我想做的一切，我对你的代码的研究也不会发现你还没有发现的任何东西。因此，我寻找一个解决方案，首先分离流程，然后以不同的方式再次加入它们 - 或许不是。这是我的“解决方案”的关键：如果零件无法连接，请让它们单独运行。因此任务 我设置的是创建单独的部分。
第1部分 这将在您的第2至4点中进行描述，即创建中级工作簿。您还没有说明为什么用户必须在创建该工作簿之前选择一个模板，但如果这有一定的影响，则可以打开和关闭该模板。我建议的重要部分是在保存中级工作簿时结束该过程。关闭它。关闭模板。项目已完成 - 第1部分。
第2部分 打开中间文件并循环遍历其数据，创建新文件。这些文件中的每一个都基于模板。如果有多个选择表单，并且中间工作簿中的数据不支持自动选择，则可能必须提供代码以启用正确模板的选择。 在此过程中，您只能打开中间工作簿，一次只能打开一个新文件。 在创建新文件之前，每个文件都会关闭。 在此过程结束时，中间文件也将关闭。 （顺便说一下，我发现你对模板的处理可能是你问题的原因。在我的流程描述中，模板永远不会打开。而是基于它创建新的工作簿，这就是发明者的设计。）
第3部分 创建或打开摘要文件。打开每个新创建的工作簿，并将一行复制到摘要中。然后关闭每个工作簿并打开下一个工作簿。 在该过程结束时，关闭“摘要”工作簿。
加入零件： 坦率地说，我会尝试从一开始就将第3部分纳入第2部分。我不相信有一个额外的工作簿打开会有所作为。但如果它确实分裂了任务。
你的两个或三个单独的程序应该是一个加载项或一个除了保存代码之外什么都不做的工作簿（向另外两个或另外三个添加一个打开的工作簿 - 这是Excel可以轻松处理的）。对于此工作簿中的代码，添加一个sub，它依次调用两个或三个proc，一个接着一个。
在此程序结构中，当可能需要花费更多时间来保存每个新工作簿时，您的问题可能会在第2部分中重现。如果发生这种情况，问题的性质将会发生变化，并且应该更容易理解，并且希望更容易解决。