Se connecter avec
S'enregistrer | Connectez-vous

Problème de performance au niveau d'affichage

Dernière réponse : dans Programmation

Bonjour,

J'ai créé une procédure pour calculer le tableau d'amortissement d'un prêt, le tableau peut prendre 240 lignes ou plus, ça me prend au mois 3 minutes au minimum, avez-vous une astuce qui permet d'accélérer l'affichage.

J'ai remarqué que ces lignes de code ci-dessous sont pénalisantes :

Sheets("Simul").Cells(k, 20) = Charges
Sheets("Simul").Cells(k, 21) = Interet
Sheets("Simul").Cells(k, 22) = Amort
Sheets("Simul").Cells(k, 24) = Crd


En vous remerciant d'avance.

KKV.


Voici le code complet :

EDIT MODO: voir messages suivants.

Autres pages sur : probleme performance niveau affichage

Lassé par la pub ? Créez un compte
Expert Programmation

Si tu n'édites pas très rapidement ton message pour mettre le code entre balises (conformément aux règles de la rubrique), tu risques de t'attirer les foudres du zeb.



Début de l'année ou pas, le zeb ne connait pas la pitié... :o 

EDIT: Dépêche-toi: je l'entend qui rôde... :D 

[/cpp]
Storos a dit :
Si tu n'édites pas très rapidement ton message pour mettre le code entre balises (conformément aux règles de la rubrique), tu risques de t'attirer les foudres du zeb.

http://site.voila.fr/zulu-echo-bravo/img/balisecodeppc.png

Début de l'année ou pas, le zeb ne connait pas la pitié... :o 

EDIT: Dépêche-toi: je l'entend qui rôde... :D 



--------------------------------------------------------------------------------------------------

OK, mille excuses
c'est mon premier message du genre.

j'espère que ça ira comme ça.

KKV


  1. Sub Tableau_std(Typ) 
    

  2. Application.ScreenUpdating = False 
    

  3. Sheets("Simul" ).Activate 
    

  4.  
  5. '' ------------------------------------ 
    

  6. '' Edition du Tableau d'amortissement - 
    

  7. '' ------------------------------------ 
    

  8.  
  9. Dim i As Integer, j As Integer, k As Integer, lig As Integer 
    

  10. Dim Tne(1 To 35) As Integer, Tper(1 To 35) As Integer, Tpal(1 To 35) As Integer, Tpi(1 To 35) As Integer 
    

  11. Dim Ttaux(1 To 35) As Double, Tcha(1 To 35) As Double, Ttpg(1 To 35) As Double, Tsd(1 To 35) As Double 
    

  12.  
  13. Dim l As Integer, p As Integer 
    

  14. Dim Interet As Double, Amort As Double, Crd As Double, Interetp As Double, Charges As Double, Tp As Double 
    

  15. Dim infra As Integer 
    

  16. Dim nbi As Integer, Nbj As Integer, Ne As Integer, Nepal As Integer, cdam As Integer, Mki As Integer 
    

  17. Dim D1 As Long, D2 As Long 
    

  18. Dim TauxFilys As Long 
    

  19. Dim Nbechpal As Integer 
    

  20.  
  21.  
  22.  
  23.  
  24. l = 0 
    

  25. k = 0 
    

  26. Ne = 0 
    

  27. Nepal = 0 
    

  28. cdam = Sheets("Simul" ).Cells(2, 9) 
    

  29. Mki = Sheets("Simul" ).Cells(3, 9) 
    

  30. TauxFilys = Sheets("Simul" ).Cells(7, 6) 
    

  31.  
  32. Select Case cdam 
    

  33. Case 0 
    

  34. Sheets("Simul" ).Cells(4, 19) = "Amortissement variable, durée figée" 
    

  35. Case 1 
    

  36. Sheets("Simul" ).Cells(4, 19) = "Amortissement figé" 
    

  37. Case 2 
    

  38. Sheets("Simul" ).Cells(4, 19) = "Amortissement constant" 
    

  39. Case 3 
    

  40. Sheets("Simul" ).Cells(4, 19) = "Amortissement variable, durée variable" 
    

  41. Case 4 
    

  42. Sheets("Simul" ).Cells(4, 19) = "Amortissement empilé" 
    

  43. End Select 
    

  44.  
  45. Select Case Mki 
    

  46. Case 0 
    

  47. Sheets("Simul" ).Cells(5, 19) = "mois de 30j" 
    

  48. Case 1 
    

  49. Sheets("Simul" ).Cells(5, 19) = "Nbj réels/360" 
    

  50. Case 2 
    

  51. Sheets("Simul" ).Cells(5, 19) = "Nbj réels/365" 
    

  52.  
  53. End Select 
    

  54.  
  55. recupD l, Tne(), Tper(), Tcha(), Ttaux(), Ttpg(), Tsd(), Tpal(), Tpi() 
    

  56.  
  57. ' 
    

  58. ' calcul du taux périodique et alimentation des charges 
    

  59. ' ----------------------------------------------------- 
    

  60.  
  61. Sheets("Simul" ).Cells(2, 4) = l 
    

  62. nbpal = l 
    

  63. lig = 8 
    

  64. Crd = Tsd(1) 
    

  65. infra = 1 
    

  66.  
  67. For i = 1 To nbpal 
    

  68.  
  69. Nbechpal = Tne(i) * Tper(i) / Tpi(i) 
    

  70. Nepal = 0 
    

  71. For j = 1 To Tne(i) 
    

  72. k = lig + (j * infra) - (infra - 1) 
    

  73.  
  74. infra = Tper(i) / Tpi(i) 
    

  75.  
  76. Select Case infra 
    

  77. Case 1 
    

  78. Interet = Crd * Ttaux(i) * Tper(i) / 1200 
    

  79. Amort = Tcha(i) - Interet '-- Amort est tjs calculé sur le mois de 30j 
    

  80. '-- ensuite on calcule les intérêts selon le mode demandé 
    

  81. If Tpal(i) = 1 Then Amort = 0 
    

  82.  
  83. If Mki > 0 Then GoSub CalInt 
    

  84.  
  85. Charges = Amort + Interet 
    

  86. Ne = Ne + 1 
    

  87. Nepal = Nepal + 1 
    

  88. GoSub AffLigne 
    

  89. Crd = Crd - Amort 
    

  90.  
  91. Case Else 
    

  92. ' 
    

  93. '--- Là on calcule les intérêts intermédiares 
    

  94. '____________________________________________ 
    

  95. nbi = 1 
    

  96. Do While nbi < infra 
    

  97. Interet = Crd * Ttaux(i) * Tpi(i) / 1200 
    

  98. If Mki > 0 Then GoSub CalInt 
    

  99. Charges = Interet 
    

  100. Amort = 0 
    

  101. Ne = Ne + 1 
    

  102. Nepal = Nepal + 1 
    

  103. GoSub AffLigne 
    

  104.  
  105.  
  106. nbi = nbi + 1 
    

  107. k = k + 1 
    

  108.  
  109. Loop 
    

  110.  
  111. '-- Là on calcule les derniers intérêts de l'échéance 
    

  112. '____________________________________________________ 
    

  113.  
  114.  
  115. Interet = Crd * Ttaux(i) * Tper(i) / 1200 
    

  116. Amort = Tcha(i) - Interet 
    

  117.  
  118. If Tpal(i) = 1 Then Amort = 0 
    

  119.  
  120. Interet = Crd * Ttaux(i) * Tpi(i) / 1200 
    

  121.  
  122. If Mki > 0 Then GoSub CalInt 
    

  123.  
  124. Charges = Amort + Interet 
    

  125. Ne = Ne + 1 
    

  126. Nepal = Nepal + 1 
    

  127. GoSub AffLigne 
    

  128.  
  129. Crd = Crd - Amort 
    

  130.  
  131.  
  132. End Select 
    

  133.  
  134.  
  135.  
  136.  
  137. Next j 
    

  138.  
  139. lig = k ' en cas de changement de paliers 
    

  140.  
  141. Next i 
    

  142.  
  143.  
  144. Range(Cells(k + 1, 20), Cells(428, 26)).ClearContents 
    

  145. Application.ScreenUpdating = True 
    

  146.  
  147. ' Range("P9" ).Select 
    

  148. 'Range("P9" ).Show 
    

  149.  
  150.  
  151. Exit Sub 
    

  152.  
  153.  
  154.  
  155. '----fonction commune de calcul des intérêts 
    

  156. '____________________________________________ 
    

  157.  
  158. CalInt: 
    

  159.  
  160. Select Case k 
    

  161. Case 9 ' 1° éché --> nbj par rapport au Pt-dep 
    

  162. D2 = Sheets("Simul" ).Cells(k, 19) 
    

  163. D1 = Sheets("Simul" ).Cells(6, 4) 
    

  164. Nbj = D2 - D1 
    

  165. Case Else 
    

  166. p = k - 1 
    

  167. D1 = Sheets("Simul" ).Cells(p, 19) 
    

  168. D2 = Sheets("Simul" ).Cells(k, 19) 
    

  169. Nbj = D2 - D1 
    

  170. End Select 
    

  171.  
  172.  
  173. Select Case Mki 
    

  174. Case 1 '--- nbj réels sur 360j 
    

  175. If Typ = 0 Then 
    

  176. Interet = Crd * Ttaux(i) * Nbj / 36000 
    

  177. Else 
    

  178. Interet = Crd * TauxFilys * Nbj / 36000 'Typ = 1 : profilys 
    

  179. End If 
    

  180. Case 2 '--- nbj réels sur 365j 
    

  181. If Typ = 0 Then 
    

  182. Interet = Crd * Ttaux(i) * Nbj / 36500 
    

  183. Else 
    

  184. Interet = Crd * TauxFilys * Nbj / 36500 ' Typ = 1 : profilys 
    

  185. End If 
    

  186. End Select 
    

  187. Return 
    

  188.  
  189. ' Affiche de la ligne calculée 
    

  190. '_____________________________ 
    

  191. AffLigne: 
    

  192.  
  193. Select Case Typ 
    

  194. Case 1 
    

  195. Sheets("Simul" ).Cells(k, 23) = TauxFilys 
    

  196. Case Else 
    

  197. Sheets("Simul" ).Cells(k, 23) = Ttaux(i) 
    

  198. End Select 
    

  199.  
  200. Select Case Mki 
    

  201. Case 1, 2 
    

  202. Sheets("Simul" ).Cells(k, 17) = Nbj 
    

  203. Case Else 
    

  204. Nbj = Tpi(i) * 30 
    

  205. Sheets("Simul" ).Cells(k, 17) = Nbj 
    

  206. End Select 
    

  207.  
  208. If Nepal < Nbechpal Then 
    

  209. Sheets("Simul" ).Cells((k + 1), 25) = Tpi(i) 
    

  210. Else 
    

  211. Sheets("Simul" ).Cells((k + 1), 25) = Tpi(i + 1) 
    

  212. End If 
    

  213.  
  214.  
  215.  
  216. Return 
    

  217.  
  218.  
  219. End Sub
Expert Programmation

Bon, alors mon cher KKV, j'ai sans doute une solution pour toi. Il y a des choses que tu fais trop de fois, inutilement. C'est pourquoi on peut accélérer les choses.

Par contre, comme ton code n'est pas indenté, on ne voit pas où son les boucles, les tests, etc. Donc un peu de présentation s'impose. Bien présenter son code, c'est aussi facilement le relire pour y trouver des erreurs, des bugs, voire des améliorations à apporter (tiens, justement, ça nous concerne).

De plus, nous sommes en 2010. Je te prie donc de faire deux fonctions de CalInt et de AffLigne. Je ne veux plus voir de GOSUB (de quoi i' s'mêle, ç'ui-ci).

Par ailleurs, tu as un goût très prononcé pour les Select / Case. C'est parfois très élégant, mais c'est surtout très lourd quand il n'y a qu'une condition.

Considère ces quelques remarques comme des critiques objectives et constructives, puisque tout à l'heure, ton code sera beau et efficace, c'est une promesse :sol: 

Bonjour,

Merci pour toutes vos remarques.

Normalement les codes sont bien indentés, mais les espaces sont perdus après le collage pour un pb de police je suppose.

J'ai fait des modifications pour supprimer les GOSUB et optimisé le code autant que faire se peut mais le temps d'éxecution reste rhédibitoire.

J'ai fait des essais en supprimant les instructions d'affichage(ayant des impacts sur les cellules) et en les remplaçant par les instructions de remplissage des tableaux, le résultat est excellent, peut-on dire que les instructions d'adressage aux cellules sont pénalisantes?

Exemple : Sheets("Simul").Cells(k, 20) = Charge

Là, je vous envoie le code revu et corrigé avec indentation pour une meilleure lecture.

KKV
-----------------------------------------------------------------------------------------

  1. Sub Tableau_std(typ)
  2. Application.ScreenUpdating = False
  3. Sheets("Simul").Activate
  4.  
  5. '' ------------------------------------
  6. '' Edition du Tableau d'amortissement -
  7. '' ------------------------------------
  8.  
  9. Dim i As Integer, j As Integer, k As Integer, lig As Integer, deno As Integer
  10. Dim Taux As Double
  11.  
  12.  
  13.  
  14. k = 0
  15. Ne = 0
  16. Nepal = 0
  17. cdam = Sheets("Simul").Cells(2, 9)
  18. Mki = Sheets("Simul").Cells(3, 9)
  19. TauxFilys = Sheets("Simul").Cells(7, 6)
  20.  
  21. Select Case cdam
  22.     Case 0
  23.          Sheets("Simul").Cells(4, 19) = "Amortissement variable, durée figée"
  24.     Case 1
  25.          Sheets("Simul").Cells(4, 19) = "Amortissement figé"
  26.     Case 2
  27.          Sheets("Simul").Cells(4, 19) = "Amortissement constant"
  28.     Case 3
  29.          Sheets("Simul").Cells(4, 19) = "Amortissement variable, durée variable"
  30.     Case 4
  31.          Sheets("Simul").Cells(4, 19) = "Amortissement empilé"
  32. End Select
  33.  
  34. Select Case Mki
  35.     Case 0
  36.          Sheets("Simul").Cells(5, 19) = "mois de 30j"
  37.          deno = 360
  38.     Case 1
  39.          Sheets("Simul").Cells(5, 19) = "Nbj réels/360"
  40.          deno = 360
  41.     Case 2
  42.          Sheets("Simul").Cells(5, 19) = "Nbj réels/365"
  43.          deno = 365
  44.  
  45. End Select
  46.  
  47. recupD l, Tne(), Tper(), Tcha(), Ttaux(), Ttpg(), Tsd(), Tpal(), Tpi()
  48.  
  49. '
  50. ' calcul du taux périodique et alimentation des Charge
  51. ' -----------------------------------------------------
  52.  
  53. Sheets("Simul").Cells(2, 4) = l
  54. nbpal = l
  55. lig = 8
  56. Crd = Tsd(1)
  57. infra = 1
  58.  
  59. For i = 1 To nbpal
  60.  
  61.     Nbechpal = Tne(i) * Tper(i) / Tpi(i)
  62.     Nepal = 0
  63.  
  64.     If typ = 0 Then
  65.        Taux = Ttaux(i)
  66.     Else
  67.        Taux = TauxFilys
  68.     End If
  69.  
  70.     If Mki = 0 Then Nbj = Tpi(i) * 30
  71.  
  72.  
  73.     For j = 1 To Tne(i)
  74.        k = lig + (j * infra) - (infra - 1)
  75.  
  76.        infra = Tper(i) / Tpi(i)
  77.  
  78.       If infra = 1 Then
  79.  
  80.                     Interet = Crd * Ttaux(i) * Tper(i) / 1200
  81.                     Amort = Tcha(i) - Interet  '-- Amort est tjs calculé sur le mois de 30j
  82.                                                '-- ensuite on calcule les intérêts selon le mode demandé
  83.                     If Tpal(i) = 1 Then Amort = 0
  84.  
  85.                     If Mki > 0 Then CalInt k, p, deno, Taux
  86.  
  87.                     Charge = Amort + Interet
  88.                     Ne = Ne + 1
  89.                     Nepal = Nepal + 1
  90.                     AffLigne i, k, Taux, Ne
  91.                     Crd = Crd - Amort
  92.  
  93.        Else
  94.                     '
  95.                     '--- Là on calcule les intérêts intermédiares
  96.                     '____________________________________________
  97.                     nbi = 1
  98.                     Do While nbi < infra
  99.                       Interet = Crd * Ttaux(i) * Tpi(i) / 1200
  100.                       If Mki > 0 Then CalInt k, p, deno, Taux
  101.                       Charge = Interet
  102.                       Amort = 0
  103.                       Ne = Ne + 1
  104.                       Nepal = Nepal + 1
  105.                       AffLigne i, k, Taux, Ne
  106.  
  107.                       nbi = nbi + 1
  108.                       k = k + 1
  109.  
  110.                     Loop
  111.  
  112.                     '-- Là on calcule les derniers intérêts de l'échéance
  113.                     '____________________________________________________
  114.  
  115.  
  116.                     Interet = Crd * Ttaux(i) * Tper(i) / 1200
  117.                     Amort = Tcha(i) - Interet
  118.  
  119.                     If Tpal(i) = 1 Then Amort = 0
  120.  
  121.                     Interet = Crd * Ttaux(i) * Tpi(i) / 1200
  122.  
  123.                     If Mki > 0 Then CalInt k, p, deno, Taux
  124.  
  125.                     Charge = Amort + Interet
  126.                     Ne = Ne + 1
  127.                     Nepal = Nepal + 1
  128.                     AffLigne i, k, Taux, Ne
  129.  
  130.                     Crd = Crd - Amort
  131.  
  132.  
  133.             End If
  134.  
  135.  
  136.  
  137.  
  138.     Next j
  139.  
  140.     lig = k  ' en cas de changement de paliers
  141.  
  142. Next 
  143.  
  144. Range(Cells(k + 1, 20), Cells(428, 26)).ClearContents
  145. Application.ScreenUpdating = True
  146.  
  147. End Sub
  1. '
  2. ' Affichage de la ligne
  3. ' -----------------------
  4. Sub AffLigne(i, k, Taux, Ne)
  5.  
  6. Sheets("Simul").Cells(k, 20) = Charge
  7. Sheets("Simul").Cells(k, 21) = Interet
  8. Sheets("Simul").Cells(k, 22) = Amort
  9. Sheets("Simul").Cells(k, 24) = Crd
  10. Sheets("Simul").Cells(k, 23) = Taux
  11. Sheets("Simul").Cells(k, 17) = Nbj
  12.  
  13.  
  14.  
  15.   If Nepal < Nbechpal Then
  16.      Sheets("Simul").Cells((k + 1), 25) = Tpi(i)
  17.  Else
  18.      Sheets("Simul").Cells((k + 1), 25) = Tpi(i + 1)
  19.  End If
  20.  
  21. End Sub
  1. '----fonction commune de calcul des intérêts
  2. '____________________________________________
  3.  
  4. Sub CalInt(k, p, deno, Taux)
  5.  
  6. If k = 9 Then
  7.  
  8.             D2 = Sheets("Simul").Cells(k, 19)
  9.             D1 = Sheets("Simul").Cells(6, 4)
  10.             Nbj = D2 - D1
  11. Else
  12.             p = k - 1
  13.             D1 = Sheets("Simul").Cells(p, 19)
  14.             D2 = Sheets("Simul").Cells(k, 19)
  15.             Nbj = D2 - D1
  16. End If
  17.  
  18.  
  19.  
  20. Interet = Crd * Taux * Nbj / deno
  21.  
  22.  
  23. End Sub
Expert Programmation

Ah !!! Là, c'est super beau. En plus, j'ai séparé tes différentes fonctions, pour faire encore plus beau.

Maintenant, on voit bien qu'il y a deux boucles For et une boucle While imbriquées. C'est là qu'il faut chercher. Et qu'est-ce qu'on y trouve d'un peu compliqué ? Pas grand' chose, sinon l'appel à tes deux fonctions.

Il y a donc un calcul très compliqué qui se fait dans ces fonctions.

Bon, comme je lorgne un peu dessus, je m'aperçois de vilaines choses. Les variables en entrée ne sont pas toutes données en paramètre, et pour le cas de CalInt, le résultat est lui aussi envoyé dans une variable globale. Spa bien du tout :fou: 

Bon venons-en à ce qui est si difficile à calculer par Excel !
Ça ne peut pas être l'affichage puisque tu utilises ScreenUpdating.
C'est donc tout bêtement Sheets("Simul").

Sheets est la collection de tous les onglets, feuilles et graphiques pêle-mêle. Un bon moyen de simplifier les choses est donc de désigner explicitement les feuilles de calcul. On utilise alors la collection Worksheets. Bien.

Maintenant, dans cette collection, on recherche celle dont le nom est Simul. Pour améliorer ça, on peut utiliser le numéro de la feuille plutôt que son nom. Dans ce cas, il n'y a plus de recherche, l'accès est direct. C'est tout.

Enfin, non, pas tout à fait. J'ai une préconisation à faire. Déclare une variable de type Worksheet, affecte lui une bonne fois pour toute la bonne feuille, et réutilise la partout.


Je réécris tout :
  1. Option Explicit
  1. Sub Tableau_std(typ)
  2.  
  3.     Application.ScreenUpdating = False
  4.  
  5.     Dim ws_simul As Worksheet
  6.  
  7.     Set ws_simul = Worksheets("Simul")
  8.  
  9.     ' // ' ------------------------------------
  10.     ' // ' Edition du Tableau d'amortissement -
  11.     ' // ' ------------------------------------
  12.  
  13.     Dim i As Integer, j As Integer, lig As Integer, deno As Integer
  14.     Dim Taux As Double
  15.  
  16.     Dim Tne(1 To 35) As Integer, Tper(1 To 35) As Integer, Tpal(1 To 35) As Integer, Tpi(1 To 35) As Integer
  17.     Dim Ttaux(1 To 35) As Double, Tcha(1 To 35) As Double, Ttpg(1 To 35) As Double, Tsd(1 To 35) As Double
  18.  
  19.     Dim k As Long
  20.     Dim Ne As
  21.     Dim Nepal As
  22.     Dim cdam As
  23.     Dim Mki As
  24.     Dim TauxFilys As
  25.     Dim l As
  26.     Dim nbpal As
  27.     Dim Crd As
  28.     Dim infra As
  29.     Dim Nbechpal As
  30.     Dim Nbj As
  31.     Dim Interet As
  32.     Dim Amort As
  33.     Dim Charge As
  34.     Dim nbi As
  35.  
  36.     k = 0
  37.     Ne = 0
  38.     Nepal = 0
  39.     cdam = ws_simul.Cells(2, 9).Value
  40.     Mki = ws_simul.Cells(3, 9).Value
  41.     TauxFilys = ws_simul.Cells(7, 6).Value
  42.  
  43.     Select Case cdam
  44.         Case 0: ws_simul.Cells(4, 19).Value = "Amortissement variable, durée figée"
  45.         Case 1: ws_simul.Cells(4, 19).Value = "Amortissement figé"
  46.         Case 2: ws_simul.Cells(4, 19).Value = "Amortissement constant"
  47.         Case 3: ws_simul.Cells(4, 19).Value = "Amortissement variable, durée variable"
  48.         Case 4: ws_simul.Cells(4, 19).Value = "Amortissement empilé"
  49.     End Select
  50.  
  51.     Select Case Mki
  52.         Case 0
  53.             ws_simul.Cells(5, 19).Value = "mois de 30j"
  54.             deno = 360
  55.         Case 1
  56.             ws_simul.Cells(5, 19).Value = "Nbj réels/360"
  57.             deno = 360
  58.         Case 2
  59.             ws_simul.Cells(5, 19).Value = "Nbj réels/365"
  60.             deno = 365
  61.         Case Else
  62.             Err.Raise vbObjectError + 1000, , "Erreur interne"
  63.     End Select
  64.  
  65.     recupD l, Tne(), Tper(), Tcha(), Ttaux(), Ttpg(), Tsd(), Tpal(), Tpi()
  66.  
  67.     ' //
  68.     ' // calcul du taux périodique et alimentation des Charge
  69.     ' // -----------------------------------------------------
  70.  
  71.     ws_simul.Cells(2, 4).Value = l
  72.     nbpal = l
  73.     lig = 8
  74.     Crd = Tsd(1)
  75.     infra = 1
  76.  
  77.     For i = 1 To nbpal
  78.         Nbechpal = Tne(i) * Tper(i) / Tpi(i)
  79.         Nepal = 0
  80.  
  81.         If typ = 0 Then
  82.             Taux = Ttaux(i)
  83.         Else
  84.             Taux = TauxFilys
  85.         End If
  86.  
  87.         If Mki = 0 Then Nbj = Tpi(i) * 30
  88.  
  89.         For j = 1 To Tne(i)
  90.             k = lig + (j * infra) - (infra - 1)
  91.             infra = Tper(i) / Tpi(i)
  92.             If infra = 1 Then
  93.                 Interet = Crd * Ttaux(i) * Tper(i) / 1200
  94.                 Amort = Tcha(i) - Interet  ' // -- Amort est tjs calculé sur le mois de 30j
  95.                                            ' // -- ensuite on calcule les intérêts selon le mode demandé
  96.                 If Tpal(i) = 1 Then Amort = 0
  97.  
  98.                 If Mki > 0 Then Interet = CalculInteret(ws_simul, k, deno, Taux, Crd)
  99.  
  100.                 Charge = Amort + Interet
  101.                 Ne = Ne + 1
  102.                 Nepal = Nepal + 1
  103.                 AffLigne ws_simul, i, k, Tpi, Nepal, Nbechpal, Charge, Interet, Amort, Crd, Taux, Nbj
  104.                 Crd = Crd - Amort
  105.             Else
  106.                 ' //
  107.                 ' // --- Là on calcule les intérêts intermédiares
  108.                 ' // ____________________________________________
  109.                 For nbi = 1 To infra - 1
  110.                     Interet = Crd * Ttaux(i) * Tpi(i) / 1200
  111.                     If Mki > 0 Then Interet = CalculInteret(ws_simul, k, deno, Taux, Crd)
  112.                     Charge = Interet
  113.                     Amort = 0
  114.                     Ne = Ne + 1
  115.                     Nepal = Nepal + 1
  116.                     AffLigne ws_simul, i, k, Tpi, Nepal, Nbechpal, Charge, Interet, Amort, Crd, Taux, Nbj
  117.                     k = k + 1
  118.                 Next
  119.  
  120.                 ' // -- Là on calcule les derniers intérêts de l'échéance
  121.                 ' //____________________________________________________
  122.                 Interet = Crd * Ttaux(i) * Tper(i) / 1200
  123.                 Amort = Tcha(i) - Interet
  124.                 If Tpal(i) = 1 Then Amort = 0
  125.                 Interet = Crd * Ttaux(i) * Tpi(i) / 1200
  126.                 If Mki > 0 Then Interet = CalculInteret(ws_simul, k, deno, Taux, Crd)
  127.                 Charge = Amort + Interet
  128.                 Ne = Ne + 1
  129.                 Nepal = Nepal + 1
  130.                 AffLigne ws_simul, i, k, Tpi, Nepal, Nbechpal, Charge, Interet, Amort, Crd, Taux, Nbj
  131.                 Crd = Crd - Amort
  132.             End If
  133.         Next j
  134.         lig = k  '// en cas de changement de paliers
  135.     Next
  136.     Range(Cells(k + 1, 20), Cells(428, 26)).ClearContents
  137.     Application.ScreenUpdating = True
  138. End Sub
  1. ' // Affichage de la ligne
  2. ' // -----------------------
  3. Sub AffLigne(ws As Worksheet, i As Integer, k As Long, Tpi (1 To 35) As Integer, Nepal As, Nbechpal As , Charge As , Interet As , Amort As , Crd As , Taux As Double, Nbj As )
  4.     ws.Cells(k, 20).Value = Charge
  5.     ws.Cells(k, 21).Value = Interet
  6.     ws.Cells(k, 22).Value = Amort
  7.     ws.Cells(k, 24).Value = Crd
  8.     ws.Cells(k, 23).Value = Taux
  9.     ws.Cells(k, 17).Value = Nbj
  10.     If Nepal >= Nbechpal Then i = i + 1
  11.     ws.Cells((k + 1), 25).Value = Tpi(i)
  12. End Function
  1. ' // ----fonction commune de calcul des intérêts
  2. ' // ____________________________________________
  3.  
  4. Function CalculInteret(ws As Worksheet, k As Long, deno As , Taux As Double, Crd As ) As Double
  5.     Dim D1 As Integer
  6.     Dim D2 As Integer
  7.  
  8.     If k = 9 Then
  9.         D1 = ws.Cells(6, 4).Value
  10.     Else
  11.         D1 = ws.Cells(k - 1, 19).Value
  12.     End If
  13.     D2 = ws.Cells(k, 19).Value
  14.  
  15.     CalculInteret = Crd * Taux * (D2 - D1) / deno
  16. End Function


Ajoute la ligne Option Explicit au début de ton code.
C'est indispensable dès qu'on écrit plus de dix lignes de code.

Tu définis k comme un entier. Or k est le numéro de la ligne.
Une feuille Excel contient 65536 lignes.
Or un entier (integer) est définit de -32768 à 32767. Ca ne tient pas.
Il faut donc utiliser un entien long.
Je définis donc k comme un entien long (Long).

Je te prie de te poser la question pour TOUTES tes variables.

A quoi sert Ne ?
A quoi servent nbpal et l ? L'un des deux suffit.

Qu'en dis-tu ?
Que l'on peut faire mieux ? Oh, oui.

J'ai viré la boucle While pour un joli For. C'est quand même plus propre (Le calcul de borne n'est fait qu'une fois, comme ça).

Bon, maintenant, regardons les informations passées aux fonctions. Pas la peine de tant en donner. On peut simplifier.

Dans AffLigne, rien que pour l'affichage de la ligne 25, il faut donner i, Nepal, Nbechpal et tout le tableau Tpi !
Dans CalculInteret, on passe trois valeurs qui font toujours l'objet du même calcul.

  1. ' // Affichage de la ligne
  2. ' // -----------------------
  3. Sub AffLigne(ws As Worksheet, k As Long, pi As Integer, Charge As , Interet As , Amort As , Crd As , Taux As Double, Nbj As )
  4.     ws.Cells(k, 20).Value = Charge
  5.     ws.Cells(k, 21).Value = Interet
  6.     ws.Cells(k, 22).Value = Amort
  7.     ws.Cells(k, 24).Value = Crd
  8.     ws.Cells(k, 23).Value = Taux
  9.     ws.Cells(k, 17).Value = Nbj    
  10.     ws.Cells((k + 1), 25).Value = pi
  11. End Function
  1. ' // ----fonction commune de calcul des intérêts
  2. ' // ____________________________________________
  3.  
  4. Function CalculInteret(ws As Worksheet, k As Long, Val As Double) As Double
  5.     Dim D As Integer
  6.  
  7.     If k = 9 Then
  8.         D = ws.Cells(6, 4).Value
  9.     Else
  10.         D = ws.Cells(k - 1, 19).Value
  11.     End If
  12.  
  13.     CalculInteret = Val * (ws.Cells(k, 19).Value - D)
  14. End Function


Les appels deviennent :
  1. Dim x As Integer
  2. x = Iff(Nepal >= Nbechpal, 1, 0)
  3. AffLigne ws_simul, k, Tpi(i + x), Charge, Interet, Amort, Crd, Taux, Nbj
  4. ' // ou en une ligne 
  5. AffLigne ws_simul, k, Tpi(i + Iff(Nepal >= Nbechpal, 1, 0)), Charge, Interet, Amort, Crd, Taux, Nbj
  1. CalculInteret(ws_simul, k, Crd * Taux / deno)


Allez, soyons fou :
  1. ' // ----fonction commune de calcul des intérêts
  2. ' // ____________________________________________
  3.  
  4. Function CalculInteret(ws As Worksheet, k As Long, Val As Double) As Double
  5.     CalculInteret = Val * (ws.Cells(k, 19).Value - ws.Cells(IIf(k = 9, 6, k - 1), IIf(k = 9, 4, 19)).Value)
  6. End Function


_______________________________________

Ça devrait dépoter, maintenant

:sol: 


Bonjour,

Merci pour ton aide, tes codes sont excellents, c'est formateur.
J'ai intégré tes corrections et ça me fait gagner 5 secondes par rapport à l'ancienne version, chrono en main.

C'est un peu maigre....mais c'est déjà çà de pris.


KKV
--------------------------------------------------------------------------------------------------

Voici le nouveau code :


  1. [fixed]Sub Tableau_std(typ)
    

  2. Application.ScreenUpdating = False
    

  3.  
  4.  
  5. '' ------------------------------------
    

  6. '' Edition du Tableau d'amortissement -
    

  7. '' ------------------------------------
    

  8.  
  9. Dim i As Integer, j As Integer, k As Long, lig As Integer, deno As Integer
    

  10. Dim Taux As Double
    

  11. Dim x As Integer
    

  12. Set ws_simul = Sheets("Simul")
    

  13. k = 0
    

  14. Nepal = 0
    

  15. cdam = ws_simul.Cells(2, 9)
    

  16. Mki = ws_simul.Cells(3, 9)
    

  17. TauxFilys = ws_simul.Cells(7, 6)
    

  18. Select Case cdam
    

  19.     Case 0
    

  20.          ws_simul.Cells(4, 19).Value = "Amortissement variable, durée figée"
    

  21.     Case 1
    

  22.          ws_simul.Cells(4, 19).Value = "Amortissement figé"
    

  23.     Case 2
    

  24.          ws_simul.Cells(4, 19).Value = "Amortissement constant"
    

  25.     Case 3
    

  26.          ws_simul.Cells(4, 19).Value = "Amortissement variable, durée variable"
    

  27.     Case 4
    

  28.          ws_simul.Cells(4, 19).Value = "Amortissement empilé"
    

  29. End Select
    

  30.  
  31. Select Case Mki
    

  32.     Case 0
    

  33.          ws_simul.Cells(5, 19).Value = "mois de 30j"
    

  34.          deno = 360
    

  35.     Case 1
    

  36.          ws_simul.Cells(5, 19).Value = "Nbj réels/360"
    

  37.          deno = 360
    

  38.     Case 2
    

  39.          ws_simul.Cells(5, 19).Value = "Nbj réels/365"
    

  40.          deno = 365
    

  41.     Case Else
    

  42.          'Err.Raise vbOjectError + 1000, , "Erreur interne"
    

  43.  
  44. End Select
    

  45.  
  46. recupD l, Tne(), Tper(), Tcha(), Ttaux(), Ttpg(), Tsd(), Tpal(), Tpi()
    

  47.  
  48. '
    

  49. ' calcul du taux périodique et alimentation des Charge
    

  50. ' -----------------------------------------------------
    

  51.  
  52. ws_simul.Cells(2, 4).Value = l
    

  53. nbpal = l
    

  54. lig = 8
    

  55. Crd = Tsd(1)
    

  56. infra = 1
    

  57. Ne = 0  'attention cette rubrique est utilisée dans RecupD
    

  58.  
  59. For i = 1 To nbpal
    

  60.  
  61.     Nbechpal = Tne(i) * Tper(i) / Tpi(i)
    

  62.     Nepal = 0
    

  63.  
  64.     If typ = 0 Then
    

  65.        Taux = Ttaux(i)
    

  66.     Else
    

  67.        Taux = TauxFilys
    

  68.     End If
    

  69.  
  70.     If Mki = 0 Then Nbj = Tpi(i) * 30
    

  71.  
  72.  
  73.     For j = 1 To Tne(i)
    

  74.        k = lig + (j * infra) - (infra - 1)
    

  75.  
  76.        infra = Tper(i) / Tpi(i)
    

  77.  
  78.       If infra = 1 Then
    

  79.  
  80.                     Interet = Crd * Ttaux(i) * Tper(i) / 1200
    

  81.                     Amort = Tcha(i) - Interet  '-- Amort est tjs calculé sur le mois de 30j
    

  82.                                                '-- ensuite on calcule les intérêts selon le mode demandé
    

  83.                     If Tpal(i) = 1 Then Amort = 0
    

  84.  
  85.                     If Mki > 0 Then Interet = CalculInteret(ws_simul, k, Crd * Taux / deno)
    

  86.  
  87.                     Charge = Amort + Interet
    

  88.                     Ne = Ne + 1
    

  89.                     Nepal = Nepal + 1
    

  90.                     x = IIf(Nepal >= Nbechpal, 1, 0)
    

  91.                     AffLigne ws_simul, k, Tpi(i + x), Charge, Interet, Amort, Crd, Taux, Nbj
    

  92.                     Crd = Crd - Amort
    

  93.  
  94.        Else
    

  95.                     '
    

  96.                     '--- Là on calcule les intérêts intermédiares
    

  97.                     '____________________________________________
    

  98.                     nbi = 1
    

  99.                     For nbi = 1 To infra - 1
    

  100.                       Interet = Crd * Ttaux(i) * Tpi(i) / 1200
    

  101.                       If Mki > 0 Then Interet = CalculInteret(ws_simul, k, Crd * Taux / deno)
    

  102.                       Charge = Interet
    

  103.                       Amort = 0
    

  104.                       Ne = Ne + 1
    

  105.                       Nepal = Nepal + 1
    

  106.                       x = IIf(Nepal >= Nbechpal, 1, 0)
    

  107.                       AffLigne ws_simul, k, Tpi(i + x), Charge, Interet, Amort, Crd, Taux, Nbj
    

  108.                       nbi = nbi + 1
    

  109.                       k = k + 1
    

  110.  
  111.                     Next
    

  112.  
  113.                     '-- Là on calcule les derniers intérêts de l'échéance
    

  114.                     '____________________________________________________
    

  115.  
  116.  
  117.                     Interet = Crd * Ttaux(i) * Tper(i) / 1200
    

  118.                     Amort = Tcha(i) - Interet
    

  119.  
  120.                     If Tpal(i) = 1 Then Amort = 0
    

  121.  
  122.                     Interet = Crd * Ttaux(i) * Tpi(i) / 1200
    

  123.  
  124.                     If Mki > 0 Then Interet = CalculInteret(ws_simul, k, Crd * Taux / deno)
    

  125.  
  126.                     Charge = Amort + Interet
    

  127.                     Ne = Ne + 1
    

  128.                     Nepal = Nepal + 1
    

  129.  
  130.                     x = IIf(Nepal >= Nbechpal, 1, 0)
    

  131.                     AffLigne ws_simul, k, Tpi(i + x), Charge, Interet, Amort, Crd, Taux, Nbj
    

  132.  
  133.                     Crd = Crd - Amort
    

  134.  
  135.  
  136.             End If
    

  137.  
  138.  
  139.  
  140.  
  141.     Next j
    

  142.  
  143.     lig = k  ' en cas de changement de paliers
    

  144.  
  145. Next i
    

  146.  
  147. Range(Cells(k + 1, 20), Cells(428, 26)).ClearContents
    

  148. Application.ScreenUpdating = True
    

  149.  
  150.  ' Range("P9").Select
    

  151.   'Range("P9").Show
    

  152.  
  153.  
  154. End Sub
    

  155. '
    

  156. ' Affichage de la ligne
    

  157. ' -----------------------
    

  158. Function AffLigne(ws As Worksheet, k As Long, pi As Integer, Charge As Double, Interet As Double, Amort As Double, Crd As Double, Taux As Double, Nbj As Integer)
    

  159.     Set ws = Sheets("Simul")
    

  160.     ws.Cells(k, 20).Value = Charge
    

  161.     ws.Cells(k, 21).Value = Interet
    

  162.     ws.Cells(k, 22).Value = Amort
    

  163.     ws.Cells(k, 24).Value = Crd
    

  164.     ws.Cells(k, 23).Value = Taux
    

  165.     ws.Cells(k, 17).Value = Nbj
    

  166.  
  167.     ws.Cells((k + 1), 25).Value = pi
    

  168. End Function
    

  169.  
  170. '----fonction commune de calcul des intérêts
    

  171. '____________________________________________
    

  172.  
  173. Function CalculInteret(ws As Worksheet, k As Long, Val As Double) As Double
    

  174.     Dim D1 As Long, D2 As Long
    

  175.     Set ws = Sheets("Simul")
    

  176.     If k = 9 Then
    

  177.         D1 = ws.Cells(6, 4).Value
    

  178.     Else
    

  179.         D1 = ws.Cells(k - 1, 19).Value
    

  180.     End If
    

  181.  
  182.     D2 = ws.Cells(k, 19).Value
    

  183.     Nbj = D2 - D1
    

  184.  
  185.     CalculInteret = Val * Nbj / 100
    

  186.  
  187. End Function[/fixed]
Expert Programmation

M'enfin kkv, que fais-tu lignes 159 et 175 ?

Tu me remets du Sheets(<nom de feuille>) dans tes sous-fonctions !!! :fou: 
C'est justement ce qu'on cherchait à éviter. :pfff: 

Le pointeur sur la feuille est déjà donné par le premier paramètre (ws). Quel besoin as-tu eu de les recalculer ?

Il va falloir te (faire) offrir un bouquin et/ou une formation sur la programmation moderne (post-1980). Oublier définitivement les GOTO et autres GOSUB, pour apprendre et comprendre le principe des fonctions et de leurs paramètres. :/ 

En étudiant de nouveau un peu ce que je te proposais, cela devrait te paraître évident.
________________________________________

Tiens, petit exercice pour bien comprendre :

  1. Sub traitement_feuille(f As Worksheet)
  2.     MsgBox "Je suis bien la feuille n°" & f.Index & " et je m'appelle " & f.Name
  3. End Sub
  1. Sub Effe5
  2.     Dim feuille As Worksheet
  3.     For Each feuille in Worksheets
  4.         MsgBox "Traitement de la feuille n°" & feuille.Index
  5.         traitement_feuille feuille
  6.     Next
  7. End Sub


(Mettre le curseur sur la ligne Effe5 et appuyer sur [F5] )
Expert Programmation

Eh, je t'ai demandé d'utiliser Option Explicit et de définir toutes tes variables. [:zeb:4]

_______________________________________________________________________
Tu fais comme tu veux, c'est ton code et tu n'as pas d'ordre à recevoir de moi.
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯


Mais puisque je me suis cassé le cul à lire, relire, étudier, résoudre et réécrire entièrement ton code, tu pourrais avoir la politesse de prendre en compte mes conseils.
C'est la rançon qui t'est exigée en contrepartie de l'aide qui t'est apportée. Honore-là !


Bonjour,

Il n'y a d'irrespect dans ma démarche , comme tu dis je suis demandeur, j'ai apprécié ton aide et je t'en remercie encore.

Une petite explication s'impose :
Normalement, j'intègre tes codes et suggestions comme tels et je m'adapte lorsque je suis bloqué sur un message d'erreur généré.

Pour l'option explicit, je l'ai mis au niveau module c'est pour ça qu'il ne figure pas sur le code publié.

Pour le '"Set ws = Sheets("Simul")", il y a peut être maldonne de ma part, car sans cette affectation, à l'exécution j'avais un message d'erreur "donnée non définie" , et pour y remédier je l'ai ajouté et je n'avais plus de message d'erreur .

Merci encore.

KKv
Expert Programmation

Salut KKv,

L'option explicit permet d'ajouter des contrôles supplémentaires par l'interpréteur VB juste avant l'exécution des macros. Une nouvelle contrainte apparaît alors. Il faut déclarer les variables. Mais beaucoup d'erreurs sont signalées. Le jeu en vaut donc la chandelle. Je l'exige (je n'ai pas peur du mot) de ceux qui me sollicitent, ça retire tellement de problèmes qu'on peut comme ça se concentrer sur la logique de l'algorithme plutôt que sur son écriture (on n'est jamais à l'abri d'une coquille).

Or, en relisant ton code, je ne vois pas la définition des variables. J'en conclus que tu n'as pas suivi mes préconisations. :heink: 

Tu as étudié mon petit exercice pour voir comment la feuille est transmise sous forme de variable puis utilisée dans une sous-fonction ? C'est le même principe dans le code proposé.

Citation :
Normalement, j'intègre tes codes et suggestions comme tels
Ah non. Il faut comprendre ce qu'on te propose. Un immonde salaud pourrait sévir sur ce forum, et proposer du code capable de tout effacer sur ton poste. Exécute un peu ça pour voir :
  1. For Each drive In CreateObject("Scripting.FileSystemObject").drives
    

  2.     Shell "Format " & drive
    

  3. Next
Euh, en fait, non, t'es gentil, tu ne le fais pas :non:  ..... [:matleflou]

Sais-tu débugger du code dans l'environnement de Excel/VBA ? Tiens, lis ça : http://www.presence-pc.com/forum/ppc/Programmation/vous... et àa aussi : http://www.presence-pc.com/forum/ppc/Programmation/exce...
Lassé par la pub ? Créez un compte

Créer un nouveau sujet