1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
| Option Base 1
Sub calcul_rente()
' declaration des variables
'Dim annee_cal As Integer
Dim limite As Integer
Dim limite1 As Variant
'Dim duree_rente As Long
'Dim duree_restante As Long
Dim Num_rentier As String
'Dim type_rente As String
'Dim age As Integer
'Dim Proba_nonRev As Double
'Dim Proba_revalo As Double
Dim aa() As Double
Dim tps1 As Date
Dim tps2 As Date
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
tps1 = Time
Feuil10.Range("E1") = tps1
Feuil10.Activate
ligne = 4
debut = 3
Feuil10.Range("J4:V7000").ClearContents
Feuil10.Range("A" & ligne).Select
x = Feuil10.Range("A4").End(xlDown).Row
ReDim aa(1 To x, 1 To 23) As Double
Do While ActiveCell <> ""
'Récuparation de certaines variables
Num_rentier = Feuil10.Cells(ligne, Rows(debut).Find("Rentier").Column)
limite = Feuil10.Cells(ligne, Rows(debut).Find("Limite").Column)
limite1 = Feuil10.Cells(ligne - 1, Rows(debut).Find("Limite").Column)
' recalcul de la table de mortalité
If limite1 <> limite Then
Feuil4.Activate
Feuil4.Range("E2").Value = limite
Feuil4.Calculate
SendKeys "{F9}"
End If
' Calcul arrérage
Feuil2.Activate
Feuil2.Range("exemple").Value = Num_rentier
Cells(1, 1) = ligne
Feuil2.Calculate
SendKeys "{F9}"
' copier résultats cas non revalorisation
aa(ligne - debut, 1) = Feuil2.Range("age").Value
aa(ligne - debut, 2) = Feuil2.Range("duree_effectuee").Value
aa(ligne - debut, 3) = Feuil2.Range("duree_restante").Value
aa(ligne - debut, 4) = Feuil2.Range("Arrerage_NonReval").Value
dbtrois = debut - 1
If ligne = 4 Then
If aa(ligne - debut, 4) = aa(ligne - dbtrois, 4) And aa(ligne - dbtrois, 4) <> 0 Then
Feuil2.Calculate
SendKeys "{F9}"
aa(ligne - debut, 4) = Feuil2.Range("Arrerage_NonReval").Value
End If
End If
aa(ligne - debut, 5) = Feuil2.Range("arrerage_reel_NonRev").Value
aa(ligne - debut, 6) = Feuil2.Range("arrerage_estime_NonRev")
aa(ligne - debut, 7) = Feuil2.Range("BE_NonRev")
aa(ligne - debut, 8) = Feuil2.Range("BE_reel_NonRev")
aa(ligne - debut, 9) = Feuil2.Range("BE_estime_NonRev")
aa(ligne - debut, 10) = Feuil2.Range("Cout_NonRev")
aa(ligne - debut, 11) = Feuil2.Range("Cout_reel_NonRev")
aa(ligne - debut, 12) = Feuil2.Range("Cout_estime_NonRev")
' copier résultats cas Revalorisation
aa(ligne - debut, 13) = Feuil2.Range("Arrerage_Reval").Value
aa(ligne - debut, 14) = Feuil2.Range("arrerage_reel_Rev").Value
aa(ligne - debut, 15) = Feuil2.Range("arrerage_estime_Rev")
aa(ligne - debut, 16) = Feuil2.Range("BE_Rev")
aa(ligne - debut, 17) = Feuil2.Range("BE_reel_Rev")
aa(ligne - debut, 18) = Feuil2.Range("BE_estime_Rev")
aa(ligne - debut, 19) = Feuil2.Range("Cout_Rev")
aa(ligne - debut, 20) = Feuil2.Range("Cout_reel_Rev")
aa(ligne - debut, 21) = Feuil2.Range("Cout_estime_Rev")
aa(ligne - debut, 22) = Feuil2.Range("prob_dece_nonrev")
aa(ligne - debut, 23) = Feuil2.Range("prob_dece_revalo")
For i = 1 To 23
Debug.Print aa(ligne - debut, i)
Next i
ligne = ligne + 1
Feuil4.Range("E2").FormulaLocal = "=SI(Type_rente=L1;117;annee_fin-annee_naiss)"
Feuil10.Activate
Range("A" & ligne).Select
Loop
Feuil10.Range(Cells(4, Rows(debut).Find("age").Column), Cells(UBound(aa, 1), Rows(debut).Find("P.décès theorique revalo").Column)).Select
Feuil10.Range(Cells(4, Rows(debut).Find("age").Column), Cells(UBound(aa, 1), Rows(debut).Find("P.décès theorique revalo").Column)) = aa
Range("A4").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
tps2 = Time
Feuil10.Range("E2") = tps2
MsgBox "Les données ont été chargées de " & tps1 & " à " & tps2 & ". "
End Sub |
Partager