Reduire temps d'execution procédure

Le 29/03/2022 à 10:59

Bonjour !

Ma procédure Excel n'est pas longue ni compliquée mais prend quand même un certain temps pour s'executer car je fais appel à différentes cellules de feuille Excel.

Une partie de mon code initial à l'intérieur d'un sub:

Worksheets("résultats").Activate
Worksheets("réserves").Activate

Risk1 = Worksheets("résultats").Range("C12").Value
Risk2 = Worksheets("résultats").Range("C13").Value
Risk3 = Worksheets("résultats").Range("C14").Value
RiskGlob = Worksheets("résultats").Range("C17").Value
Franchise = Worksheets("résultats").Range("C18").Value
Division = Worksheets("résultats").Range("C19").Value

Je voudrais donc, pour contrer ce problème, créer un tableau et faire chercher ces valeurs directement dans celui-ci.

J'ai essayé avec le code suivant :

Dim v As Variant
Dim rg As Variant

Set rg = Worksheets("résultats").Range("B3:C27")
v = rg

Worksheets("résultats").Activate
Worksheets("réserves").Activate

Risk1 = v(2, 10)
Risk2 = v(2, 11)
Risk3 = v(2, 12)
RiskGlob = v(2, 15)
Franchise = v(2, 16)
Division = v(2, 17)

Mais cela me renvoie une erreur d'exécution. Savez vous m'expliquer l'erreur faite dans ce code ?

De plus, voici les cellules Excel qui m'intéressent :

capture

Je vous remercie par avance !!!!

Le 29/03/2022 à 11:05

Bonjour Hellor, Bienvenue sur le forum.

Vos codes ne font que de la saisie de variables ? Je ne pense pas que ce soit à l'origine d'un temps d'exécution trop long.

Sinon essayer en début et fin de code ces commandes, c'est toujours très efficace.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'(code ici)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

A+

Le 29/03/2022 à 11:09

Mon code entier est celui ci :

(Mais je ne voulais pas vous embêter avec trop de matière ;))

Effectivement ça marche bien avec ces entrées ! Merci !

Mais j'aimerai tout de même réussir à utiliser un tableau 

Sub reserves()

Worksheets("réserves").Range("A1:E662").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Risk1 As String
Dim Risk2 As String
Dim Risk3 As String
Dim RiskGlob As String
Dim RiskGlobM As String
Dim Franchise As String
Dim Division As String
Dim Prime As Double
Dim rend As Double
Dim BirthDate As Date
Dim gender As String
Dim DateCalcul As Date
Dim RiskAjout As String
Dim AgeAjout As Double
Dim RiskRetrait As String
Dim ageRetrait As Double
Dim v As Variant
Dim rg As Variant

Set rg = Worksheets("résultats").Range("B3:C27")
v = rg

Worksheets("résultats").Activate
Worksheets("réserves").Activate

Risk1 = Worksheets("résultats").Range("C12").Value
Risk2 = Worksheets("résultats").Range("C13").Value
Risk3 = Worksheets("résultats").Range("C14").Value
RiskGlob = Worksheets("résultats").Range("C17").Value
Franchise = Worksheets("résultats").Range("C18").Value
Division = Worksheets("résultats").Range("C19").Value

Prime = Worksheets("résultats").Range("C8").Value
rend = Worksheets("résultats").Range("C9").Value
BirthDate = Worksheets("résultats").Range("C4").Value
gender = Worksheets("résultats").Range("C5").Value
DateCalcul = Worksheets("résultats").Range("F2").Value
RiskAjout = Worksheets("résultats").Range("C22").Value
AgeAjout = Worksheets("résultats").Range("C23").Value
RiskRetrait = Worksheets("résultats").Range("C26").Value
ageRetrait = Worksheets("résultats").Range("C27").Value

If Division = "Privée" And Franchise = "0.-" And RiskGlob = "Global Smart" Then RiskGlobM = "GO GA - P - F0"
If Division = "Privée" And Franchise = "0.-" And RiskGlob = "Global Solution" Then RiskGlobM = "GO AM - P - F0"
If Division = "Privée" And Franchise = "500.-" And RiskGlob = "Global Smart" Then RiskGlobM = "GO GA - P - F500"
If Division = "Privée" And Franchise = "500.-" And RiskGlob = "Global Solution" Then RiskGlobM = "GO AM - P - F500"
If Division = "Privée" And Franchise = "1000.-" And RiskGlob = "Global Smart" Then RiskGlobM = "GO GA - P - F1000"
If Division = "Privée" And Franchise = "1000.-" And RiskGlob = "Global Solution" Then RiskGlobM = "GO AM - P - F1000"

If Division = "Mi-privée" And Franchise = "0.-" And RiskGlob = "Global Smart" Then RiskGlobM = "GO GA - MP - F0"
If Division = "Mi-privée" And Franchise = "0.-" And RiskGlob = "Global Solution" Then RiskGlobM = "GO AM - MP - F0"
If Division = "Mi-privée" And Franchise = "500.-" And RiskGlob = "Global Smart" Then RiskGlobM = "GO GA - MP - F500"
If Division = "Mi-privée" And Franchise = "500.-" And RiskGlob = "Global Solution" Then RiskGlobM = "GO AM - MP - F500"
If Division = "Mi-privée" And Franchise = "1000.-" And RiskGlob = "Global Smart" Then RiskGlobM = "GO GA - MP - F1000"
If Division = "Mi-privée" And Franchise = "1000.-" And RiskGlob = "Global Solution" Then RiskGlobM = "GO AM - MP - F1000"

If RiskGlob = "-" Then RiskGlobM = "-"
RiskGlobM = "-"

Dim PrimeRisk1() As Double
Dim PrimeRisk2() As Double
Dim PrimeRisk3() As Double
Dim PrimeRiskGlob() As Double
Dim PrimeRiskAjout() As Double
Dim Retrait() As Double
Dim CumulAvoir As Double
Dim AvoirAnnee() As Double
Dim vecteur(4) As Variant
Dim CapitalAcquis As Double

Dim AvoirPrev As Double
Dim age As Double
Dim NmbMoisRetraite As Integer

Dim ArrayRisk1 As Range
Dim ArrayRisk2 As Range
Dim ArrayRisk3 As Range
Dim ArrayRiskGlob As Range
Dim ArrayRiskAjout As Range
Dim ArrayRetrait As Range

Dim AgeRetraite As Integer

Dim j As Integer
Dim i As Integer
Dim k As Integer
Dim l As Integer
Dim w As Integer
Dim colonne As Integer

'Paramtres frais
Dim FraisFixes As Double
Dim FraisPrimes As Double
Dim FraisAvoir As Double
Dim AugmPrimeAnnee As Double

FraisFixes = 100
FraisPrimes = 0.05
FraisAvoir = 0.004
AugmPrimeAnnee = 0.01     'Taux d'augmentation des primes par années

If gender = "F" Then colonne = 2 Else colonne = 3

'Calcul de l'‰ge exact
age = Year(DateCalcul) - Year(BirthDate) + Month(DateCalcul) / 12 - Month(BirthDate) / 12

'Age Retraite en fonction du genre

If gender = "F" Then AgeRetraite = 64 Else AgeRetraite = 65

'Calcul du nombre de mois avant retraite

NmbMoisRetraite = ((AgeRetraite - age) * 12)
Dim NmbMoisAR As Integer
If gender = "F" Then NmbMoisAR = (80 - 64) * 12 Else NmbMoisAR = (80 - 65) * 12

Dim NmbMois As Integer
NmbMois = NmbMoisRetraite + NmbMoisAR

ReDim PrimeRisk1(NmbMois)
ReDim PrimeRisk2(NmbMois)
ReDim PrimeRisk3(NmbMois)
ReDim PrimeRiskGlob(NmbMois)
ReDim AvoirAnnee(NmbMois)
ReDim PrimeRiskAjout(NmbMois)
ReDim Retrait(NmbMois)

'Definition des plages ou rechercher les primes de risque en fonction des offres chosie

Set ArrayRisk1 = ThisWorkbook.Sheets(Risk1).Range("A1:C1300")
Set ArrayRisk2 = ThisWorkbook.Sheets(Risk2).Range("A1:C1300")
Set ArrayRisk3 = ThisWorkbook.Sheets(Risk3).Range("A1:C1300")
Set ArrayRiskGlob = ThisWorkbook.Sheets(RiskGlobM).Range("A1:C1300")
Set ArrayRiskAjout = ThisWorkbook.Sheets(RiskAjout).Range("A1:C1300")
Set ArrayRetrait = ThisWorkbook.Sheets(RiskRetrait).Range("A1:C1300")

' Création Array pour les primes de risk 1 & 2 et pour l'avoir de chaque année

For j = 1 To NmbMois
    PrimeRisk1(j) = Application.WorksheetFunction.VLookup(Int(age + j / 12), ArrayRisk1, colonne, False) * (1 + AugmPrimeAnnee) ^ Int(j / 12)

Next j

For k = 1 To NmbMois
    PrimeRisk2(k) = Application.WorksheetFunction.VLookup(Int(age + k / 12), ArrayRisk2, colonne, False) * (1 + AugmPrimeAnnee) ^ Int(k / 12)
    PrimeRisk3(k) = Application.WorksheetFunction.VLookup(Int(age + k / 12), ArrayRisk3, colonne, False) * (1 + AugmPrimeAnnee) ^ Int(k / 12)
    PrimeRiskGlob(k) = Application.WorksheetFunction.VLookup(Int(age + k / 12), ArrayRiskGlob, colonne, False) * (1 + AugmPrimeAnnee) ^ Int(k / 12)
Next k

'Partie ajout en cours de route
Dim NmbMoisSansAjout As Integer
Dim m As Integer
Dim n As Integer

NmbMoisSansAjout = (AgeAjout - age) * 12

For m = 1 To NmbMoisSansAjout - 1
    PrimeRiskAjout(m) = 0
Next m

For n = NmbMoisSansAjout To NmbMois
    PrimeRiskAjout(n) = Application.WorksheetFunction.VLookup(Int(age + n / 12), ArrayRiskAjout, colonne, False) * (1 + AugmPrimeAnnee) ^ Int(n / 12)
Next n

Debug.Print PrimeRiskAjout(1)

'Partie retrait en cours de route
Dim NmbMoisSansRetrait As Integer
Dim a As Integer
Dim b As Integer

NmbMoisSansRetrait = (ageRetrait - age) * 12

For a = 1 To NmbMoisSansRetrait - 1
    Retrait(a) = 0
Next a

For b = NmbMoisSansRetrait To NmbMois
    Retrait(b) = Application.WorksheetFunction.VLookup(Int(age + b / 12), ArrayRetrait, colonne, False) * (1 + AugmPrimeAnnee) ^ Int(b / 12)
Next b

' Calcul avoit total mensuel

For l = 1 To NmbMois

    AvoirAnnee(l) = Prime + Retrait(l) - PrimeRisk1(l) - PrimeRisk2(l) - PrimeRisk3(l) - PrimeRiskGlob(l) - PrimeRiskAjout(l) - FraisPrimes * (PrimeRisk1(l) + PrimeRisk2(l) + PrimeRisk3(l) + PrimeRiskAjout(l) - Retrait(l)) - FraisFixes / 12

Next l

'Boucle Calcul de l'avoir ˆ la retraite

CumulAvoir = 0
Worksheets("réserves").Activate
For i = 1 To NmbMois

    CumulAvoir = CumulAvoir * (1 + rend / 12) ^ (1 / 12) + AvoirAnnee(i)
    Worksheets("réserves").Range("B" & i + 1).Value = CumulAvoir
    Worksheets("réserves").Range("A" & i + 1).Value = Int(age + i / 12)

Next i

For w = 1 To NmbMois
   Worksheets("réserves").Range("C" & w + 1) = PrimeRisk1(w) + PrimeRisk2(w) + PrimeRisk3(w) + PrimeRiskGlob(w) - Retrait(w) + PrimeRiskAjout(w)
     Worksheets("réserves").Range("D" & w + 1) = Prime
Next w

Dim NmbAnnee As Integer
Dim p As Integer
NmbAnnee = NmbMois / 12

For p = 1 To NmbAnnee + 1
Worksheets("réserves").Range("E" & p + 1) = age + p - 1

Next p

Debug.Print PrimeRisk1(1)
Debug.Print PrimeRisk2(1)
Debug.Print PrimeRisk3(1)
Debug.Print PrimeRiskGlob(1)
Debug.Print Retrait(1)
Debug.Print PrimeRiskAjout(1)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Le 29/03/2022 à 11:16

Re,

(Mais je ne voulais pas vous embêter avec trop de matière ;))

Et pourtant c'est plus simple comme cela !

Même si le début de code où on saisie les variables (données d'entrées) peut être optimisé légèrement, je suis certains que la latence arrive bien après au niveau des boucles ! il y en à beaucoup.

Vous pouvez faire le test, marquez

stop

vers la ligne 144 avant les boucles. exécutez le code et je pense qu'en une fraction de secondes vous arrivez au stop.

Mais j'aimerai tout de même réussir à utiliser un tableau

Vous semblez pourtant déjà bien maitriser les tableaux !

exemple:
ReDim PrimeRisk1(NmbMois)
ReDim PrimeRisk2(NmbMois)
ReDim PrimeRisk3(NmbMois)
ReDim PrimeRiskGlob(NmbMois)
ReDim AvoirAnnee(NmbMois)
ReDim PrimeRiskAjout(NmbMois)
ReDim Retrait(NmbMois)

Sur quoi avez-vous besoin d'aide exactement ?

A+

Le 29/03/2022 à 12:51

Re ! Je tiens d'abord à te remercier pour ton aide, je n'ai pas eu le même accueil sur d'autres forums

En faite j'aimerai pouvoir faire aller chercher mes valeurs à ma macro directement dans un tableau et non dans le fichier Excel (ça devient presque une histoire d'ego et plus d'optimisation hahah).

Donc faire ce que j'ai essayé de faire là :

Dim v As Variant
Dim rg As Variant

Set rg = Worksheets("résultats").Range("B3:C27")
v = rg

Worksheets("résultats").Activate
Worksheets("réserves").Activate

Risk1 = v(2, 10)
Risk2 = v(2, 11)
Risk3 = v(2, 12)
RiskGlob = v(2, 15)
Franchise = v(2, 16)
Division = v(2, 17)

Est-ce une histoire de type ? Vu que certain sont des string, d'autres des double etc?

Le 29/03/2022 à 13:24

Re,

Visiblement "rg" ne sert à rien ? a essayer simplement comme cela:

Dim v As Variant

v = Worksheets("résultats").Range("B3:C27")

Mais l'erreur ne doit pas venir de là, vous inversez ligne et colonne dans le tableau v()

Exemple la cellule C8 devrais être v(6,2)

A+

Rechercher des sujets similaires à "reduire temps execution procedure"