Microsoft 365 Formule qui ralenti ma macro

Coralie01120 · 7 Octobre 2021

Bonjour le Forum,

J'ai créer une macro à base de formules qui fonctionne parfaitement. Le seul hic c'est la lenteur de la macro.

J'ai identifié la ligne qui plante, la macro met 2 min 18 à s'exécuter contre 5 sec sans cette formule :

.Range("AH2").FormulaLocal = "=SI(NB.SI.ENS($K$1:K1;K2;$AF$1:AF1;AF2)=0;RECHERCHEV(K2;'Historique Heures théoriques'!$G$5:$J$392;SI(AF2=""Equipe 2 (soir)"";4;3);FAUX);0)"
.Range("AH2").AutoFill .Range("AH2:AH" & DerLigne1)

Y'a t'il un moyen pour accélérer l'exécution ?

Merci pour votre aide

Voici l'ensemble de la macro :

Sub MiseAJour_Click()

Dim usf1 As UserForm1
Set usf1 = New UserForm1

Dim usf2 As UserForm2
Set usf2 = New UserForm2

Dim DerLigne As Long
Dim plage1 As Range, plage2
Dim donnee As Variant, cell

Application.ScreenUpdating = False

' afficher le userform1
usf1.Show 0
usf1.Repaint

' ajouter les données dans Extraction_Intraprint
With Sheets("Extraction_Intraprint")
.Activate

DerLigne1 = Range("A" & Rows.Count).End(xlUp).Row

' libellé opération
.Range("P2").FormulaLocal = "=RECHERCHEV(H2;Données!$B$3:$C$21;2;FAUX)"
.Range("P2").AutoFill .Range("P2" & DerLigne1)

' mois
.Range("Q2").FormulaLocal = "=RECHERCHEV(MOIS(K2);Données!$E$3:$F$14;2;FAUX)"
.Range("Q2").AutoFill .Range("Q2:Q" & DerLigne1)

' semaine
.Range("R2").FormulaLocal = "=NO.SEMAINE(K2)-1"
.Range("R2").AutoFill .Range("R2:R" & DerLigne1)

' XFR
.Range("S2").FormulaLocal = "=SIERREUR(RECHERCHEV(J2;Extraction_AS400!$C:$H;2;FAUX);0)"
.Range("S2").AutoFill .Range("S2:S" & DerLigne1)

' nb d'étuis roulés
.Range("U2").FormulaLocal = "=SI($P2=""ROULAGE"";$N2;"""")"
.Range("U2").AutoFill .Range("U2:U" & DerLigne1)

' vitesse réelle
.Range("V2").FormulaLocal = "=SIERREUR($U2/$X2;"""")"
.Range("V2").AutoFill .Range("V2:V" & DerLigne1)

' vitesse théorique (à mettre à jour manuellement quand elle est dépassée et cohérente)
.Range("W2").FormulaLocal = "=SI($P2=""Roulage"";SIERREUR(RECHERCHEV(S2;VREF!$A:$E;4;FAUX);0);0)"
.Range("W2").AutoFill .Range("W2:W" & DerLigne1)

' temps de roulage Réel
.Range("X2").FormulaLocal = "=SI($P2=""Roulage"";$M2;"""")"
.Range("X2").AutoFill .Range("X2:X" & DerLigne1)

' temps roulage Théorique
.Range("Y2").FormulaLocal = "=SIERREUR($N2/$W2;0)"
.Range("Y2").AutoFill .Range("Y2:Y" & DerLigne1)

' temps de calage Réel (NON MASQUE)
.Range("Z2").FormulaLocal = "=SI(OU($H2=""CALAGE COLLAGE"";$H2=""CALAGE KOHMANN"");$M2;"""")"
.Range("Z2").AutoFill .Range("Z2:Z" & DerLigne1)

' temps calage Théorique
.Range("AA2").FormulaLocal = "=SI(OU($H2=""CALAGE COLLAGE"";$H2=""CALAGE KOHMANN"");SIERREUR(RECHERCHEV(E2;Données!$I:$K;3;FAUX);0);0)"
.Range("AA2").AutoFill .Range("AA2:AA" & DerLigne1)

' temps de TAD Réel
.Range("AB2").FormulaLocal = "=SI($P2=""TAD"";$M2;0)"
.Range("AB2").AutoFill .Range("AB2:AB" & DerLigne1)

' TAD Théorique
.Range("AC2").FormulaLocal = "=AG2*RECHERCHEV(E2;Données!$I$4:$J$9;2;FAUX)"
.Range("AC2").AutoFill .Range("AC2:AC" & DerLigne1)

'temps Vide de Ligne Réel
.Range("AD2").FormulaLocal = "=SI($H2=""VIDE DE LIGNE"";$M2;"""")"
.Range("AD2").AutoFill .Range("AD2:AD" & DerLigne1)

'temps Vide de Ligne Théorique
.Range("AE2").FormulaLocal = "=SI($H2=""VIDE DE LIGNE"";0,08;0)"
.Range("AE2").AutoFill .Range("AE2:AE" & DerLigne1)

'Equipe
.Range("AF2").FormulaLocal = "=SI(ET($L2>""05:40:00"";$L2<=""14:00:00"");""Equipe 1 (matin)"";""Equipe 2 (soir)"")"
.Range("AF2").AutoFill .Range("AF2:AF" & DerLigne1)

'TO Théorique
.Range("AG2").FormulaLocal = "=(Y2+AA2+AE2)/(1-RECHERCHEV($E2;Données!$I$4:$J$9;2;FAUX))"
.Range("AG2").AutoFill .Range("AG2:AG" & DerLigne1)

'Heures Théoriques
.Range("AH2").FormulaLocal = "=SI(NB.SI.ENS($K$1:K1;K2;$AF$1:AF1;AF2)=0;RECHERCHEV(K2;'Historique Heures théoriques'!$G$5:$J$392;SI(AF2=""Equipe 2 (soir)"";4;3);FAUX);0)"
.Range("AH2").AutoFill .Range("AH2:AH" & DerLigne1)

'Nbre calages
.Range("AI2").FormulaLocal = "=SI(Z2="""";0;1)"
.Range("AI2").AutoFill .Range("AI2:AI" & DerLigne1)

'Nbre VdL
.Range("AJ2").FormulaLocal = "=SI(AD2="""";0;1)"
.Range("AJ2").AutoFill .Range("AJ2:AJ" & DerLigne1)

' remplacement des formules par les valeurs

Columns("P:AJ").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End With

'------------------------------------------------
' mettre à jour les TCDs
ActiveWorkbook.RefreshAll

' afficher le userform 2
Unload usf1
usf2.Show 0

Application.Wait (Now + TimeValue("00:00:02"))
Unload usf2

Sheets("VREF").Activate

Application.ScreenUpdating = True

End Sub

sylvanu · 11 Octobre 2021

Bonjour Coralie, MaPomme,

Effectivement je ne l'avais pas vu. C'est d'ailleurs aussi le cas pour d'autres formules.
Ceci est du au multiple copier coller, les index ne suivent pas.
J'ai tout essayé, mon système ne marche pas. Ou ça ne parche pas, ou ça marche et ça rame.

Je suis donc revenu en arrière avec un "gros mix" de votre fichier, de la macro de Mapomme pour la colonne AH et de ma tambouille. J'arrive à 1.8s pour 15k lignes.
Mais je suis coincé coté test à cause des diverses feuilles qui sont vierges.
Pouvez vous tester ? et accessoirement me donner le temps d'exécution que vous avez sur votre PC.

Hasco · 7 Octobre 2021

Bonjour,

Arrêtez le calcul automatique au début si vous n'avez pas besoin des résultats intermédiaires dans votre macro

VB:

Application.Calculation = xlCalculationManual

Rétablissez en Fin

Code:

Application.Calculation = xlCalculationAutomatic

Cordialement

sylvanu · 7 Octobre 2021

Bonjour Coralie, Hasco,
On peut aussi figer l'affichage, et remplir d'un coup toute la colonne avec la formule :

VB:

Sub Formule()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    DerLigne = Range("A" & Rows.Count).End(xlUp).Row
    Range(Cells(2, "AH"), Cells(DerLigne, "AH")).FormulaLocal = _
    "=SI(NB.SI.ENS($K$1:K1;K2;$AF$1:AF1;AF2)=0;RECHERCHEV(K2;'Historique Heures théoriques'!$G$5:$J$392;SI(AF2=""Equipe 2 (soir)"";4;3);FAUX);0)"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Coralie01120 · 7 Octobre 2021

Je me suis trompée, cela ne fonctionne pas non plus...

sylvanu · 7 Octobre 2021

Fournissez nous un fichier test.
En PJ une maquette faite "en aveugle" avec 1000 lignes, sur mon PC la macro s'exécute en 0.25s.

Coralie01120 · 7 Octobre 2021

Voici le fichier mais j'ai du supprimer le nombre de ligne car le fichier était trop volumineux.
L'extraction compte 11562 lignes et augmente tous les jours. C'est le nombre de ligne trop conséquent qui prend du temps... Car avant avec ces 11562 lignes j'étais à 137 sec et avec 27 lignes je suis à 0,10 sec.

sylvanu · 7 Octobre 2021

Bonsoir,
Il arrive qu'à partir d'un certain nombre de lignes, XL se mette à ramer car les opérations sont lourdes.
J'ai essayé une astuce, en ne travaillant que par paquet de 100 lignes. sur un fichier de 10000 lignes je suis passé de 8.5s à 0.45s.
La taille des paquets peut être ajustée avec "Taille="
Sur mon PC, à iso-fichier, j'ai :
- à l'origine 8.5s
- paquets de 1000 1.6s
- paquets de 500 0.97s
- paquets de 100 0.45s
Pouvez vous tester ?

Code:

Sub Formule()
    T0 = Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    derligne = Range("A" & Rows.Count).End(xlUp).Row
    Taille = 100    ' Taille des paquets. Sur mon PC, 100 semble être l'optimum. A optimiser.
    For L = 2 To derligne Step Taille
        Lmax = L + Taille
        If L + Taille > derligne Then Lmax = derligne
        Range(Cells(L, "AH"), Cells(Lmax, "AH")).FormulaLocal = _
        "=SI(NB.SI.ENS($K$1:K1;K2;$AF$1:AF1;AF2)=0;RECHERCHEV(K2;'Historique Heures théoriques'!$G$2:$J$392;SI(AF2=""Equipe 2 (soir)"";4;3);FAUX);0)"
    Next L
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Temps d'exécution : " & Round(Timer - T0, 3) & "s"
End Sub

mapomme · 7 Octobre 2021

Bonsoir à tous ,

Une autre approche via une procédure au lieu d'une fonction.
L'avantage est qu'on supprime les formules de la colonne AH (voir le code dans module1).
Une gestion de la couleur du bouton Hop! est nécessaire (voir le court code dans le module de ThisWorkbook). Bouton Hop! Rouge => un re-calcul est nécessaire, bouton Hop! vert => les données n'ont pas changé.
Init sert juste à la démo pour recopier les 27 lignes de la source sur environ 15 000 lignes de données.

Le temps d'exécution sur ma bécane est de 0,08 secondes pour 15 000 lignes source.

edit : bonsoir @sylvanu

Coralie01120 · 8 Octobre 2021

Bonjour,

Merci à vous deux. Les deux techniques fonctionnent. Je suis passée de 2min18 à 60 sec

Bonne journée,

sylvanu · 8 Octobre 2021

Bonjour Coralie, MaPomme,
Vous pouvez encore améliorer avec ma méthode par segments ( et encore plus avec la méthode de Mapomme par dico, pour ceux qui en ont la compétence ), en continuant d'enrichir les formules à mettre. Par ex :

VB:

    For L = 2 To derligne Step 100
        Lmax = L + 100
        If L + 100 > derligne Then Lmax = derligne
        'Heures Théoriques
        Range(Cells(L, "AH"), Cells(Lmax, "AH")).FormulaLocal = _
        "=SI(NB.SI.ENS($K$1:K1;K2;$AF$1:AF1;AF2)=0;RECHERCHEV(K2;'Historique Heures théoriques'!$G$2:$J$392;SI(AF2=""Equipe 2 (soir)"";4;3);FAUX);0)"
        ' libellé opération
        Range(Cells(L, "P"), Cells(Lmax, "P")).FormulaLocal = _
        "=RECHERCHEV(H2;Données!$B$3:$C$21;2;FAUX)"
        ' mois
        Range(Cells(L, "Q"), Cells(Lmax, "Q")).FormulaLocal = _
        "=RECHERCHEV(MOIS(K2);Données!$E$3:$F$14;2;FAUX)"
        ' semaine
        Range(Cells(L, "R"), Cells(Lmax, "R")).FormulaLocal = "=NO.SEMAINE(K2)-1"

Je me suis arrêté à "temps calage Théorique".
Testez cette PJ, il suffit d'appuyer sur le bouton.
J'obtiens sur mon PC autour de une seconde, mais il n'y a que 11 formules. Mais on est loin de vos 60s.

mapomme · 8 Octobre 2021

Bonjour @sylvanu ,

Le "Copyright MaPomme" m'a fait sourire

sylvanu · 10 Octobre 2021

Bonjour Coralie, MaPomme,
Just for the fun.
J'ai essayé d'accélérer l'ensemble et simplifier l'écriture en passant un array qu'on remplit avec les N° de colonnes et les formules.
Pour l'ensemble des formules et sur 15k lignes, sur mon PC, je suis à 2.5s.

Coralie01120 · 11 Octobre 2021

Bonjour Sylvanu,
La macro va nettement plus vite par contre les formules ne sont plus justes car décalées. Par exemple, si je prend la ligne 199 colonne U je vais avoir la formule suivante : =SI($P99="ROULAGE";$N99;"") alors que je souhaite avoir =SI($P199="ROULAGE";$N199;"").

Une idée pour rétablir les bonnes valeurs de référence ?

Merci pour votre aide.

sylvanu · 11 Octobre 2021

Bonjour Coralie, MaPomme,

Effectivement je ne l'avais pas vu. C'est d'ailleurs aussi le cas pour d'autres formules.
Ceci est du au multiple copier coller, les index ne suivent pas.
J'ai tout essayé, mon système ne marche pas. Ou ça ne parche pas, ou ça marche et ça rame.

Je suis donc revenu en arrière avec un "gros mix" de votre fichier, de la macro de Mapomme pour la colonne AH et de ma tambouille. J'arrive à 1.8s pour 15k lignes.
Mais je suis coincé coté test à cause des diverses feuilles qui sont vierges.
Pouvez vous tester ? et accessoirement me donner le temps d'exécution que vous avez sur votre PC.

sylvanu · 11 Octobre 2021

Vous obtenez quel temps en appuyant sur le bouton ?

Microsoft 365 Formule qui ralenti ma macro

Coralie01120

XLDnaute Occasionnel

sylvanu

Hasco

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Coralie01120

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

Coralie01120

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Coralie01120

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

Coralie01120

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Discussions similaires