Augmenter lentement le gain de temps lors de l'enregistrement comme dans Excel

Question

Ok, Stack Overflow, pour autant que je sache, celui-ci est un doozy.

J'ai créé une macro activé le fichier excel qui, lorsqu'il est exécuté, effectue les actions suivantes (de haut niveau):

1. L'utilisateur sélectionne le fichier de modèle (qui est lui-même macro activée) par boîte de dialogue de fichier
2. utilisateur sélectionne les fichiers de données (qui ne sont pas activés pour les macros) également via la boîte de dialogue
3. La macro parcourt les fichiers de données et les ouvre un à un, formate les données, migre les données dans une nouvelle feuille de calcul dans un classeur intermédiaire, puis se ferme le fichier de données sans l'enregistrer
4. Une fois tous les fichiers bouclés, le classeur intermédiaire est également sauvegardé mais maintenu ouvert
5. Une fois que tous les fichiers de données ont été bouclés, chaque feuille du classeur intermédiaire est bouclée, les données de la feuille de calcul courante sont transférées au fichier modèle, et le fichier modèle est enregistré en tant que nouveau fichier étiqueté de façon unique. Une ligne de données dans ce fichier contenant maintenant les données sont copiées dans une feuille récapitulative

(Il est un peu plus compliqué que cela, mais ce sont les aspects importants pour autant que je peux dire)

Voici le problème. le nombre de fichiers de données sélectionnés est de l'ordre de plusieurs milliers (jusqu'à présent, la plus grande exécution que nous avons essayée est de 4000 fichiers). Au fur et à mesure que la macro progresse, le temps nécessaire à l'enregistrement de ces fichiers diminue lentement mais régulièrement. Cela commence à environ cinq secondes, mais à la fin, certains fichiers prennent environ cinq minutes pour être sauvegardés. Le seul indice que j'ai est qu'il y a une fonctionnalité d'itération que j'ai ajouté, une fois que tous les fichiers de données ont été bouclés, il ferme complètement le fichier modèle et ouvre une nouvelle instance avec des paramètres différents, puis recommence le processus. Cela fait revenir le temps de sauvegarde à la normale, puis recommence à croître. Le fichier récapitulatif est également enregistré et fermé au cours de cette étape et un nouveau fichier est ouvert pour la nouvelle itération. J'ai envisagé de fermer et de rouvrir le fichier gabarit chaque centaine de fichiers de données, et je l'implémenterai si je le dois, mais je préférerais obtenir une solution appropriée à ce problème plutôt qu'une approche de pansement. . Si j'ouvre et ferme le fichier template à chaque fois, j'évite le problème de temps, mais alors la macro devient instable, où elle va parfois planter à des points complètement aléatoires pendant la course (mais seulement parfois).

Il s'agit d'un ordinateur qui est isolé de l'Internet ou de tout type de réseau et enregistre dans un lecteur à état solide (nous avons essayé de contrôler un certain nombre de variables).

De toute façon, je suis assez perplexe, donc toutes les suggestions sont les bienvenues!

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

Désolé de poster ceci comme une réponse, ce qui n'est pas le cas, mais j'ai besoin d'un peu d'espace ici. J'ai parcouru votre code, j'ai trouvé que l'IntermediateWorkbook n'est pas défini et j'ai décidé que le définir ne ferait pas de différence. Je suis certain que vous avez fait tout ce que je pouvais penser et mon étude de votre code ne découvrira rien que vous n'avez pas déjà découvert. Par conséquent, je cherche une solution en séparant d'abord les processus et en les rejoignant ensuite d'une manière différente - ou peut-être pas. C'est la clé de ma "solution": si les pièces ne peuvent pas être jointes, laissez-les tourner séparément. Par conséquent, la tâche que je définis est de créer des parties séparées.

Partie 1 Ceci est décrit dans les points 2 à 4, c'est-à-dire la création du classeur intermédiaire. Vous n'avez pas indiqué pourquoi l'utilisateur doit sélectionner un modèle avant que ce classeur ne soit créé, mais si cela a un certain sens, ce modèle peut être ouvert et fermé. La partie importante de ma suggestion est de terminer le processus lorsque le classeur intermédiaire est enregistré. Ferme le. Fermez le modèle. Et le projet est terminé - partie 1.

Partie 2 Ouvrez le fichier intermédiaire et bouclez ses données, en créant de nouveaux fichiers. Chacun de ces fichiers est basé sur un modèle. Vous devrez peut-être fournir du code pour permettre la sélection du bon modèle s'il y en a plusieurs à choisir et si les données du classeur Intermédiaire ne prennent pas en charge la sélection automatique. Dans ce processus, vous avez uniquement le classeur Intermédiaire ouvert plus un nouveau fichier à la fois. Chaque fichier est fermé avant la création d'un nouveau fichier. À la fin de ce processus, le fichier intermédiaire est également fermé. (Il m'est apparu que votre gestion du modèle pourrait être la cause de votre problème.Dans ma description du processus, le modèle n'est jamais ouvert.À la place, de nouveaux classeurs sont créés, et c'est le design de l'inventeur.)

Partie 3 Créez ou ouvrez le fichier Résumé. Ouvrez chacun des classeurs nouvellement créés et copiez une ligne dans le récapitulatif. Puis fermez chaque classeur et ouvrez le suivant. À la fin du processus, fermez le classeur Résumé.

Rejoindre les pièces: Franchement, j'essaierais d'intégrer la partie 3 dans la partie 2 dès le départ. Je ne crois pas que l'ouverture d'un cahier d'exercices supplémentaire ferait la différence. Mais si c'est le cas, divisez les tâches. Vos deux ou trois procédures distinctes devraient être dans un Add-in peut-être ou un classeur qui ne fait que garder le code (en ajoutant un classeur ouvert aux deux ou trois autres - quelque chose qu'Excel peut gérer facilement). Au code de ce classeur, vous ajoutez un sub qui appelle successivement les deux ou trois procs l'un après l'autre.

Dans cette structure de programme, votre problème peut refaire surface dans la partie 2, car il peut prendre progressivement plus de temps pour enregistrer chaque nouveau classeur. Si cela se produit, la nature du problème aura changé et devrait être plus facile à comprendre et, espérons-le, plus facile à résoudre.