Optimisation code VBA
f
Bonjour,
J'ai un soucis avec une macro qui prend énormément de temps. Le Fichier Excel est plutôt lourd et c'est pour cela que j'évite au maximum de rafraîchir les feuilles Excel. Pouvez-vous m'aider à diminuer le temps d’exécution?
Merci
Sub Solva_module()
On Error GoTo RecoverFromError
Application.Calculation = xlManual
Application.EnableEvents = False
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Dim Nb_Contrats As Single
Dim Pol_Term_Y As Single
Dim Nb_Chocs As Single
Dim Be_gross() As Double
Dim BE_Net() As Double
Dim BE_TG() As Double
Dim BE_TG_No_PB() As Double
Dim BE_UC() As Double
Dim BE_UC_No_PB() As Double
Dim BE_Exp() As Double
Dim Prem_Prev As Double
Dim Prem_TG As Double
Dim Prem_UC As Double
'Dim PU As Double
Prem_Prev = 0
Prem_TG = 0
Prem_UC = 0
'PU = 0
Dim NBV As Double
NBV = 0
Dim CSR_Evol(45) As Double
Dim Res_Prev_LU_GAAP(45) As Double
Dim Res_TG_LU_GAAP(45) As Double
Dim Res_UC_LU_GAAP(45) As Double
Dim Prem_Evol(45) As Double
Dim SheetName As String
Dim CF_Evol(50) As Double
Nb_Contrats = Sheets("Param_Solva_II").Cells(6, 3).Value
Nb_Runs = 19
sheet_Name = Sheets("Param_Solva_II").Cells(2, 3).Value '& "-" & Cells(4, 3).Value
Sheets("Constitutif_Survie").Range("R3:zz567").ClearContents
Sheets("Constitutif_RTO").Range("R3:zz567").ClearContents
Sheets(sheet_Name).Range("BA2:FH1000").ClearContents
Sheets(sheet_Name).Range("FJ3:FQ1000").ClearContents
Sheets(sheet_Name).Range("FS3:FZ1000").ClearContents
Sheets(sheet_Name).Range("GB2:GL1000").ClearContents
Sheets(sheet_Name).Range("GN3:GX1000").ClearContents
Sheets(sheet_Name).Range("GZ3:IQ1000").ClearContents
ReDim Be_gross(Nb_Contrats, Nb_Runs)
ReDim BE_Net(Nb_Contrats, Nb_Runs)
ReDim BE_TG(Nb_Contrats, Nb_Runs)
ReDim BE_TG_No_PB(Nb_Contrats, Nb_Runs)
ReDim BE_UC(Nb_Contrats, Nb_Runs)
ReDim BE_UC_No_PB(Nb_Contrats, Nb_Runs)
ReDim BE_Exp(Nb_Contrats, 4)
For j = 1 To Nb_Runs
Application.StatusBar = "Veuillez patienter traitement en cours [" & Format(j / Nb_Runs, "00.0%") & "]"
For choc = 1 To Nb_Runs
If choc = j Then
Sheets("Param_Solva_II").Cells(8 + choc, 3).Value = "Oui"
Else
Sheets("Param_Solva_II").Cells(8 + choc, 3).Value = "Non"
End If
Next
For i = 1 To Nb_Contrats
Sheets("Calcul").Cells(22, 3).Value = i
Sheets("Calcul").Cells(5, 2).Value = "Oui"
Calculate
Pol_Term_Y = Sheets("Calcul").Cells(36, 3).Value
'
Be_gross(i, j) = Sheets("Calcul").Cells(13, 3).Value
BE_Net(i, j) = Sheets("Calcul").Cells(15, 3).Value
BE_TG(i, j) = Sheets("Calcul").Cells(16, 3).Value
BE_UC(i, j) = Sheets("Calcul").Cells(17, 3).Value
If j = 1 Or j = 2 Or j = 3 Then
BE_Exp(i, j) = Sheets("Calcul").Cells(18, 3).Value
Else
If j = 19 Then
BE_Exp(i, 4) = Sheets("Calcul").Cells(18, 3).Value
End If
End If
Sheets("Calcul").Cells(5, 2).Value = "Non"
Calculate
BE_TG_No_PB(i, j) = Sheets("Calcul").Cells(16, 3).Value
BE_UC_No_PB(i, j) = Sheets("Calcul").Cells(17, 3).Value
Sheets("Calcul").Cells(5, 2).Value = "Oui"
Calculate
If j = 1 Then
Prem_Prev = Prem_Prev + WorksheetFunction.Sum(Range("IE3:IE14").Value)
Prem_TG = Prem_TG + WorksheetFunction.Sum(Range("IV3:IV14").Value)
Prem_UC = Prem_UC + WorksheetFunction.Sum(Range("JC3:JC14").Value)
' PU = PU + Sheets("Calcul").Cells(71, 3).Value
NBV = NBV + Sheets("Calcul").Cells(9, 3).Value
For t = 1 To Pol_Term_Y + 1
CSR_Evol(t) = CSR_Evol(t) + Sheets("Calcul").Cells(3 + (t - 1) * 12, 289).Value + Sheets("Calcul").Cells(3 + (t - 1) * 12, 290).Value
Res_Prev_LU_GAAP(t) = Res_Prev_LU_GAAP(t) + Sheets("Calcul").Cells(3 + (t - 1) * 12, 295).Value
Res_TG_LU_GAAP(t) = Res_TG_LU_GAAP(t) + Sheets("Calcul").Cells(3 + (t - 1) * 12, 296).Value
Res_UC_LU_GAAP(t) = Res_UC_LU_GAAP(t) + Sheets("Calcul").Cells(3 + (t - 1) * 12, 297).Value
For cf_count = 0 To 11
' CF_Evol(t) = CF_Evol(t) + Sheets("Calcul").Cells(3 + (t - 1) * 12 + cf_count, 112).Value
Prem_Evol(t) = Prem_Evol(t) + Sheets("Calcul").Cells(3 + (t - 1) * 12 + cf_count, 239).Value + Sheets("Calcul").Cells(3 + (t - 1) * 12 + cf_count, 256).Value + Sheets("Calcul").Cells(3 + (t - 1) * 12 + cf_count, 263).Value
Next
Next
End If
Next
Next
For i = 1 To Nb_Contrats
Sheets(sheet_Name).Cells(1 + i, 53).Value = Be_gross(i, 1)
Sheets(sheet_Name).Cells(1 + i, 54).Value = BE_Net(i, 1)
Sheets(sheet_Name).Cells(1 + i, 55).Value = BE_TG(i, 1)
Sheets(sheet_Name).Cells(1 + i, 56).Value = BE_UC(i, 1)
Sheets(sheet_Name).Cells(1 + i, 57).Value = BE_TG_No_PB(i, 1)
Sheets(sheet_Name).Cells(1 + i, 58).Value = BE_UC_No_PB(i, 1)
Sheets(sheet_Name).Cells(1 + i, 59).Value = BE_Exp(i, 1)
Sheets(sheet_Name).Cells(1 + i, 162).Value = BE_Exp(i, 2)
Sheets(sheet_Name).Cells(1 + i, 163).Value = BE_Exp(i, 3)
Sheets(sheet_Name).Cells(1 + i, 164).Value = BE_Exp(i, 4)
Next
For j = 2 To WorksheetFunction.Min(18, Nb_Runs)
For i = 1 To Nb_Contrats
Sheets(sheet_Name).Cells(1 + i, 60 + (j - 2) * 6).Value = Be_gross(i, j)
Sheets(sheet_Name).Cells(1 + i, 61 + (j - 2) * 6).Value = BE_Net(i, j)
Sheets(sheet_Name).Cells(1 + i, 62 + (j - 2) * 6).Value = BE_TG(i, j)
Sheets(sheet_Name).Cells(1 + i, 63 + (j - 2) * 6).Value = BE_UC(i, j)
Sheets(sheet_Name).Cells(1 + i, 64 + (j - 2) * 6).Value = BE_TG_No_PB(i, j)
Sheets(sheet_Name).Cells(1 + i, 65 + (j - 2) * 6).Value = BE_UC_No_PB(i, j)
Next
Next
Worksheets(sheet_Name).Range("FJ2:FQ2").Copy Destination:=Worksheets(sheet_Name).Range("FJ2:FQ" & Nb_Contrats + 1)
Worksheets(sheet_Name).Range("Fs2:Fz2").Copy Destination:=Worksheets(sheet_Name).Range("Fs2:Fz" & Nb_Contrats + 1)
Worksheets(sheet_Name).Range("gz2:iq2").Copy Destination:=Worksheets(sheet_Name).Range("gz2:iq" & Nb_Contrats + 1)
For t = 1 To 45
Sheets(sheet_Name).Cells(1 + t, 184).Value = CSR_Evol(t)
Sheets(sheet_Name).Cells(1 + t, 186).Value = Res_Prev_LU_GAAP(t)
Sheets(sheet_Name).Cells(1 + t, 187).Value = Res_TG_LU_GAAP(t)
Sheets(sheet_Name).Cells(1 + t, 188).Value = Res_UC_LU_GAAP(t)
Sheets(sheet_Name).Cells(1 + t, 192).Value = Prem_Evol(t)
Next
Sheets(sheet_Name).Range("GG2").Value = Prem_Prev
Sheets(sheet_Name).Range("GH2").Value = Prem_TG
Sheets(sheet_Name).Range("GI2").Value = Prem_UC
Sheets(sheet_Name).Range("GK2").Value = NBV
'Réinitialisation calcul Best Estimate
Sheets("Param_Solva_II").Cells(9, 3).Value = "Oui"
For j = 2 To Nb_Runs
Sheets("Param_Solva_II").Cells(9 + j - 1, 3).Value = "Non"
Next j
RecoverFromError:
If Err <> 0 Then
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly, "Error Encountered"
Err.Clear
End If
On Error GoTo 0 ' clears error trapping
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
Application.EnableEvents = True ' reset this
Application.DisplayAlerts = True ' if needed
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Bonjour,
Commente le
Calculate
et reteste.
f
Merci pour la réponse j'ai en effet tester avant de voir la réponse et le problème vient bien de là...
Il va falloir que je calculate uniquement les colonnes nécessaires à chaque fois, pas d'autre choix!
Merci beaucoup!