Problème de performance
Bonjour tout le monde,
Je suis nouveau sur ce forum, mais ça fait déjà quelques temps que je développe des Macros dans Excel pour le travail.
Mon problème aujourd'hui est un problème de performance avec une macro.
J'ai une macro avec deux boucles imbriquées (voir code ci-dessous). La première boucle "primaire" s'effectue 5 fois, et pour chacune des 5 fois, il y a une boucle secondaire qui s'effectue 500 fois. Or, à chaque exécution, la première exécution de la boucle primaire prendre 5 à 6 secondes à s'exécuter (la première des 5 fois), ensuite les 4 autres sont très très rapide (environ 0,2 seconde).
Quoique que je fasse, c'est toujours comme ça. Les données dans mes feuilles de calcul ne sont pas en cause, puisque j'ai essayé d'inverser la boucle (de 5 à 1), et j'ai aussi essayé de commencer ma boucle à 2 (jusqu'à 5) en sautant la première pour vérifier que ce ne sont vraiment pas mes données lors de la première exécution, qui font que c'est long..Mais en vain...Je ne trouve pas pourquoi la première exécution de la boucle primaire est 25 fois plus longue que les 2e, 3e, 4e et 5e exécution de la même boucle.
Avez-vous une idée ? Est-ce que c'est normal ? Excel met-il en cache, des données utilisées lors de ma première boucle, ce qui rendrait les autres exécutions plus rapide ?
merci de votre aide!
Patrick
Mon code:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim ws As Range
Set ws = Sheets("Sprints").Cells
Dim wru As Range
Set wru = Sheets("Récits Utilisateurs").Cells
Dim i As Integer
Dim RowInWRU As Integer
Dim NoSprint As Integer
Dim RowInWS As Integer
For NoSprint = 1 To 5 'Primary loop
For RowInWRU = 1 To 500 'Secondary loop
If wru.Cells(RowInWRU, 5).Value = NoSprint And Len(wru.Cells(RowInWRU, 3).Value) > 1 Then
'Copying the values
ws(RowInWS, 3).Value = wru(RowInWRU, 3).Value
ws(RowInWS, 4).Value = wru(RowInWRU, 6).Value
ws(RowInWS, 5).Value = wru(RowInWRU, 7).Value
ws(RowInWS, 6).Value = wru(RowInWRU, 8).Value
ws(RowInWS, 7).Value = wru(RowInWRU, 9).Value
ws(RowInWS, 8).Value = wru(RowInWRU, 10).Value
ws(RowInWS, 9).Value = wru(RowInWRU, 11).Value
ws(RowInWS, 10).Value = wru(RowInWRU, 12).Value
ws(RowInWS, 11).Value = wru(RowInWRU, 13).Value
ws(RowInWS, 12).Value = wru(RowInWRU, 14).Value
ws(RowInWS, 13).Value = wru(RowInWRU, 15).Value
ws(RowInWS, 14).Value = wru(RowInWRU, 16).Value
ws(RowInWS, 15).Value = wru(RowInWRU, 17).Value
ws(RowInWS, 16).Value = wru(RowInWRU, 18).Value
ws(RowInWS, 17).Value = wru(RowInWRU, 19).Value
ws(RowInWS, 18).Value = wru(RowInWRU, 20).Value
ws(RowInWS, 19).Value = wru(RowInWRU, 23).Value
ws(RowInWS, 20).Value = wru(RowInWRU, 24).Value
ws(RowInWS, 21).Value = wru(RowInWRU, 25).Value
ws(RowInWS, 22).Value = wru(RowInWRU, 26).Value
ws(RowInWS, 23).Value = wru(RowInWRU, 27).Value
ws(RowInWS, 24).Value = wru(RowInWRU, 28).Value
ws(RowInWS, 25).Value = wru(RowInWRU, 4).Value
'Copying the formatting
' There are not a lot of formatting in my spreadsheet,
' so these lines of code below do not take long to run(because I first check if there is special formatting)
ws(RowInWS, 12).Interior.Color = wru(RowInWRU, 14).Interior.Color 'It is important to copy the interior color
If IsNull(wru(RowInWRU, 15).Font.Bold) Or wru(RowInWRU, 15).Font.Bold Or IsNull(wru(RowInWRU, 15).Font.ColorIndex) Or wru(RowInWRU, 15).Font.ColorIndex <> 1 Then
For i = 1 To wru(RowInWRU, 15).Characters.Count
ws(RowInWS, 13).Characters(i, 1).Font.Bold = wru(RowInWRU, 15).Characters(i, 1).Font.Bold
ws(RowInWS, 13).Characters(i, 1).Font.Color = wru(RowInWRU, 15).Characters(i, 1).Font.Color
Next i
End If
ws(RowInWS, 13).Interior.Color = wru(RowInWRU, 15).Interior.Color
If IsNull(wru(RowInWRU, 16).Font.Bold) Or wru(RowInWRU, 16).Font.Bold Or IsNull(wru(RowInWRU, 16).Font.ColorIndex) Or wru(RowInWRU, 16).Font.ColorIndex <> 1 Then
For i = 1 To wru(RowInWRU, 16).Characters.Count
ws(RowInWS, 14).Characters(i, 1).Font.Bold = wru(RowInWRU, 16).Characters(i, 1).Font.Bold
ws(RowInWS, 14).Characters(i, 1).Font.Color = wru(RowInWRU, 16).Characters(i, 1).Font.Color
Next i
End If
ws(RowInWS, 14).Interior.Color = wru(RowInWRU, 16).Interior.Color
If IsNull(wru(RowInWRU, 18).Font.Bold) Or wru(RowInWRU, 18).Font.Bold Or IsNull(wru(RowInWRU, 18).Font.ColorIndex) Or wru(RowInWRU, 18).Font.ColorIndex <> 1 Then
For i = 1 To wru(RowInWRU, 18).Characters.Count
ws(RowInWS, 16).Characters(i, 1).Font.Bold = wru(RowInWRU, 18).Characters(i, 1).Font.Bold
ws(RowInWS, 16).Characters(i, 1).Font.Color = wru(RowInWRU, 18).Characters(i, 1).Font.Color
Next i
End If
ws(RowInWS, 16).Interior.Color = wru(RowInWRU, 18).Interior.Color
ws.Rows(RowInWS).AutoFit 'Would it be better to perform the autofit on the whole sheet, once?
If ws(RowInWS, 11).Value = "Terminé TI" Then
ws.Range(Cells(RowInWS, 1), Cells(RowInWS, 25)).Interior.Color = RGB(192, 192, 192)
End If
RowInWS = RowInWS + 1
End If
Next
Next
Bonjour Patrick,
Essais de voir si le code suivant améliore le temps de la première instance de ta boucle:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim ws As Worksheet
Set ws = Sheets("Sprints")
Dim wru As Range
Set wru = Sheets("Récits Utilisateurs").UsedRange
Dim i As Integer
Dim RowInWRU As Integer
Dim NoSprint As Integer
Dim RowInWS As Integer
For NoSprint = 1 To 5 'Primary loop
For RowInWRU = 1 To 500 'Secondary loop
If wru.Cells(RowInWRU, 5).Value = NoSprint And Len(wru.Cells(RowInWRU, 3).Value) > 1 Then
'Copying the values
ws.Cells(RowInWS, 3).Value = wru(RowInWRU, 3).Value
ws.Cells(RowInWS, 4).Value = wru(RowInWRU, 6).Value
ws.Cells(RowInWS, 5).Value = wru(RowInWRU, 7).Value
ws.Cells(RowInWS, 6).Value = wru(RowInWRU, 8).Value
ws.Cells(RowInWS, 7).Value = wru(RowInWRU, 9).Value
ws.Cells(RowInWS, 8).Value = wru(RowInWRU, 10).Value
ws.Cells(RowInWS, 9).Value = wru(RowInWRU, 11).Value
ws.Cells(RowInWS, 10).Value = wru(RowInWRU, 12).Value
ws.Cells(RowInWS, 11).Value = wru(RowInWRU, 13).Value
ws.Cells(RowInWS, 12).Value = wru(RowInWRU, 14).Value
ws.Cells(RowInWS, 13).Value = wru(RowInWRU, 15).Value
ws.Cells(RowInWS, 14).Value = wru(RowInWRU, 16).Value
ws.Cells(RowInWS, 15).Value = wru(RowInWRU, 17).Value
ws.Cells(RowInWS, 16).Value = wru(RowInWRU, 18).Value
ws.Cells(RowInWS, 17).Value = wru(RowInWRU, 19).Value
ws.Cells(RowInWS, 18).Value = wru(RowInWRU, 20).Value
ws.Cells(RowInWS, 19).Value = wru(RowInWRU, 23).Value
ws.Cells(RowInWS, 20).Value = wru(RowInWRU, 24).Value
ws.Cells(RowInWS, 21).Value = wru(RowInWRU, 25).Value
ws.Cells(RowInWS, 22).Value = wru(RowInWRU, 26).Value
ws.Cells(RowInWS, 23).Value = wru(RowInWRU, 27).Value
ws.Cells(RowInWS, 24).Value = wru(RowInWRU, 28).Value
ws.Cells(RowInWS, 25).Value = wru(RowInWRU, 4).Value
'Copying the formatting
' There are not a lot of formatting in my spreadsheet,
' so these lines of code below do not take long to run(because I first check if there is special formatting)
ws.Cells(RowInWS, 12).Interior.Color = wru(RowInWRU, 14).Interior.Color 'It is important to copy the interior color
If IsNull(wru(RowInWRU, 15).Font.Bold) Or wru(RowInWRU, 15).Font.Bold Or IsNull(wru(RowInWRU, 15).Font.ColorIndex) Or wru(RowInWRU, 15).Font.ColorIndex <> 1 Then
For i = 1 To wru(RowInWRU, 15).Characters.Count
ws.Cells(RowInWS, 13).Characters(i, 1).Font.Bold = wru(RowInWRU, 15).Characters(i, 1).Font.Bold
ws.Cells(RowInWS, 13).Characters(i, 1).Font.Color = wru(RowInWRU, 15).Characters(i, 1).Font.Color
Next i
End If
ws.Cells(RowInWS, 13).Interior.Color = wru(RowInWRU, 15).Interior.Color
If IsNull(wru(RowInWRU, 16).Font.Bold) Or wru(RowInWRU, 16).Font.Bold Or IsNull(wru(RowInWRU, 16).Font.ColorIndex) Or wru(RowInWRU, 16).Font.ColorIndex <> 1 Then
For i = 1 To wru(RowInWRU, 16).Characters.Count
ws.Cells(RowInWS, 14).Characters(i, 1).Font.Bold = wru(RowInWRU, 16).Characters(i, 1).Font.Bold
ws.Cells(RowInWS, 14).Characters(i, 1).Font.Color = wru(RowInWRU, 16).Characters(i, 1).Font.Color
Next i
End If
ws.Cells(RowInWS, 14).Interior.Color = wru(RowInWRU, 16).Interior.Color
If IsNull(wru(RowInWRU, 18).Font.Bold) Or wru(RowInWRU, 18).Font.Bold Or IsNull(wru(RowInWRU, 18).Font.ColorIndex) Or wru(RowInWRU, 18).Font.ColorIndex <> 1 Then
For i = 1 To wru(RowInWRU, 18).Characters.Count
ws.Cells(RowInWS, 16).Characters(i, 1).Font.Bold = wru(RowInWRU, 18).Characters(i, 1).Font.Bold
ws.Cells(RowInWS, 16).Characters(i, 1).Font.Color = wru(RowInWRU, 18).Characters(i, 1).Font.Color
Next i
End If
ws.Cells(RowInWS, 16).Interior.Color = wru(RowInWRU, 18).Interior.Color
ws.Rows(RowInWS).AutoFit 'Would it be better to perform the autofit on the whole sheet, once?
If ws.Cells(RowInWS, 11).Value = "Terminé TI" Then
ws.Range(ws.Cells(RowInWS, 1), ws.Cells(RowInWS, 25)).Interior.Color = RGB(192, 192, 192)
End If
End If
Next
NextMerci beaucoup! J'essai ça tout de suite!
Bonjour Gérard,
ça ne change pas les performances malheureusement...Mes temps sont quasi-identique...
Merci tout de même pour votre proposition !
Patrick
Bonsoir,
J'écrirais la procédure ainsi :
Sub XYZ()
Dim ws As Worksheet, i%, j%, RowInWRU%, NoSprint%, RowInWS%, LgWS(22)
Set ws = Sheets("Sprints")
RowInWS = 2
Application.ScreenUpdating = False
With Sheets("Récits Utilisateurs")
For NoSprint = 1 To 5
For RowInWRU = 1 To 500
If .Cells(RowInWRU, 5) = NoSprint And Len(.Cells(RowInWRU, 3)) > 1 Then
LgWS(0) = .Cells(RowInWRU, 3): LgWS(22) = .Cells(RowInWRU, 4)
For i = 1 To 15
LgWS(i) = .Cells(RowInWRU, i + 5)
Next i
For i = 16 To 21
LgWS(i) = .Cells(RowInWRU, 3)
Next i
ws.Cells(RowInWS, 3).Resize(, 23).Value = LgWS
For i = 15 To 17
With .Cells(RowInWRU, i - (i = 17))
If .Font.Bold Then
ws.Cells(RowInWS, i - 2 - (i = 17)).Font.Bold = True
ElseIf IsNull(.Font.Bold) Then
For j = 1 To Len(.Text)
ws.Cells(RowInWS, i - 2 - (i = 17)).Characters(j, 1) _
.Font.Bold = .Characters(j, 1).Font.Bold
Next j
End If
If .Font.Color <> vbBlack Then
ws.Cells(RowInWS, i - 2 - (i = 17)) = .Font.Color
ElseIf IsNull(.Font.Color) Then
For j = 1 To Len(.Text)
ws.Cells(RowInWS, i - 2 - (i = 17)).Characters(j, 1) _
.Font.Color = .Characters(j, 1).Font.Color
Next j
End If
End With
Next i
For i = 14 To 17
With .Cells(RowInWRU, i - (i = 17))
ws.Cells(RowInWS, i - 2 - (i = 17)).Interior.Color = .Interior.Color
End With
Next i
If ws.Cells(RowInWS, 11) = "Terminé TI" Then
ws.Cells(RowInWS, 1).Resize(, 25).Interior.Color = RGB(192, 192, 192)
End If
RowInWS = RowInWS + 1
End If
Next RowInWRU
Next NoSprint
End With
ws.Rows.AutoFit
End SubCommentaires -
Si la procédure était reproduite intégralement (on n'est jamais sûr quand on n'a pas le Sub ET le End Sub, et quand les règles conventionnelles ne sont pas respectées : déclaration de toutes les variables en tête de procédure avant tout code exécutable...), la variable RowInWS n'était pas initialisée, ce qui aurait dû déclencher une erreur sur la première boucle, car la ligne 0 a du mal à être trouvée sur la feuille...
Je l'ai initialisée à 2, à tout hasard ! Vérifier que cela correspond, ou rectifier.
Des 5 lignes destinées vraisemblablement à accélérer l'exécution, je ne retiens que l'inhibition du rafraîchissement de l'affichage (ScreenUpdating) qui accélère effectivement de façon très conséquente (et que Excel ramène à True automatiquement). Les autres, je n'ai jamais constaté que ça accélérait quoi que ce soit (y compris le recalcul, qu'à l'inverse, j'ai été souvent obligé de forcer, ayant besoin de nouvelles valeurs calculées, car il ne s'opérait pas spontanément entre deux procédures enchaînées...) Quant à l'interruption des évènements, elle n'est justifiée que si une procédure Change est active sur ws et serait déclenchée par l'écriture sur la feuille (si on maintient cette interruption parce justifiée, là il faut ramener la valeur à True en fin de macro...)
Les affectations de variables Range par .Cells (toute la feuille) ne me paraissant pas spécialement optimales, je reviens à des variables Worksheet... En fait une seule, en plaçant la feuille source sous With on économise une variable (With jouant le même rôle et en principe en plus rapide...)
Transfert de la ligne par une variable tableau de 23 éléments. La ligne est servie autant que possible en utilisant des boucles, au prix d'une petite gymnastique (encore raisonnable, sans quoi j'aurais bouclé au moyen d'un tableau des colonnes à prélever). Affectation à la cible de la ligne, en une fois...
Par contre, sur la mise en forme, difficile de gagner si on doit passer caractère par caractère (le copier-coller est plus lent que le transfert de valeurs, mais avec la mise en forme il y aurait peut-être matière à mesurer ?) J'ai essayé de la réduire avec des boucles d'une part, et en dissociant les test sur la police. En effet le test IsNull indique pour la graisse qu'il y a à la fois des caractères gras et non gras, et pour la couleur, qu'il y a plusieurs couleurs, dans ce cas, il faut passer caractère par caractère, mais si c'est tout gras et d'une seule couleur (autre que noir) on peut affecter globalement...
Petite explication sur ces boucles (15 à 17 et 14 à 17) au cas où... alors qu'on passe de 16 à 18 en sautant le 17, l'expression -(i = 17) est destinée à faire sauter de 16 à 18, c'est une expression booléenne qui renverra 0 tant que i est inférieur à 17 et lorsque i atteindra 17 reverra -1, ce qui en la retranchant produira alors 18 (17 - (-1)).
J'ai basculé l'autofit lignes hors boucles car cela peut se faire globalement.
Il reste une marge de gain en travaillant avec des tableaux (affecter la plage source en valeurs à une variable de type Variant, ce qui produit un tableau avec lequel on peut opérer plus rapidement que sur la plage. Mais gain relatif car pour la mise en forme on est obligé de revenir à la plage, le tableau ne récupérant que les valeurs.
J'espère n'avoir pas fait d'erreur de recopie dans les numéros de ligne et les paramètres...
Cordialement.
Bonjour MFerrand,
Il n'y a qu'un mot qui vient en tête: WOW !
Vraiment, après avoir appliquez vos recommandations, la macro est passé de 7 secondes au total à un peu moins de 3 secondes!
Le temps d'exécution de la première itération de ma boucle primaire est maintenant similaire aux autres! MERCI BEAUCOUP !!! Vous codez super bien!!
Pour répondre à certaines de vos questions, je n'avais effectivement pas donné tout le code de la SUB, seulement l'extrait qui était problématique en terme de performance.
Merci encore !
Patrick