Microsoft 365 Formule qui ralenti ma macro

[Coralie01120]

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

 

[mapomme]

Bonsoir à tous ,

@sylvanu
Pour ma pomme, le message dit: