Méthode de Monté Carlo, pour le nbr Pi, Vba Résolu

Question

Bonjour, nous somme étudiants et nous avons un projet sous Vba, cependant nous avons quelques problèmes de programmation. 

Je vous explique notre problème : 

Voici notre code sous Vba : 

Sub PI() 
Dim X, Y As Double 
Dim I, J, K, Max, M, N As Long 
Worksheets("Feuil1").Select 
Max = Cells(1, 7) 
ActiveSheet.ChartObjects("Graphique 1").Activate 
ActiveChart.PlotArea.Select 
ActiveChart.SeriesCollection(1).XValues = "=Feuil1!R1C5:R" & Max & "C5" 
ActiveChart.SeriesCollection(1).Values = "=Feuil1!R1C6:R" & Max & "C6" 
ActiveChart.Axes(xlCategory).MinimumScale = 0 
ActiveChart.Axes(xlCategory).MaximumScale = Max 
Worksheets("Feuil1").Cells(1, 1).Select 
J = 0 
K = 0 
M = -10000 
N = 10000 
For I = 1 To Max 
    X = Rnd() 
    Y = Rnd() 
    If X ^ 2 + Y ^ 2 <= 1 Then 
        J = J + 1 
        Cells(J, 1) = X 
        Cells(J, 2) = Y 
    Else 
        K = K + 1 
        Cells(K, 3) = X 
        Cells(K, 4) = Y 
    End If 
    Cells(I, 5) = I 
    Cells(I, 6) = 4 * J / I 
    M = IIf(Cells(I, 6) > M, Cells(I, 6), M) 
    N = IIf(Cells(I, 6) < N, Cells(I, 6), N) 
Next 
ActiveSheet.ChartObjects("Graphique 1").Activate 
ActiveChart.PlotArea.Select 
ActiveChart.Axes(xlValue).MinimumScale = N 
ActiveChart.Axes(xlValue).MaximumScale = M 
End Sub 

La partie "ActiveSheet.ChartObjects("Graphique 1").Activate 
ActiveChart.PlotArea.Select 
ActiveChart.SeriesCollection(1).XValues = "=Feuil1!R1C5:R" & Max & "C5" 
ActiveChart.SeriesCollection(1).Values = "=Feuil1!R1C6:R" & Max & "C6" 
ActiveChart.Axes(xlCategory).MinimumScale = 0 
ActiveChart.Axes(xlCategory).MaximumScale = Max 
Worksheets("Feuil1").Cells(1, 1).Select" est un peu compliqué et nous avons un peu de mal a la comprendre néanmoins la raison qui nous pousse a demander de l'aide n'est pas celle ci, nous recherchons à schématiser l'application de la formule de Monté Carlo a travers la surface d'un cercle dans un carré 

Je vous link ce que nous cherchons a faire malheureusement nous n'arrivons pas a le coder sous Vba  
http://therese.eveilleau.pagesperso-orange.fr/pages/truc_mat/textes/monte_carlo.htm 

Si vous pouviez nous apporter votre aide, ce serait très appréciable 

Merci d'avance 

Configuration: Windows 7 / Firefox 9.0.1

ccm81 · Accepted Answer

Bonjour

un essai (un peu) simplifié
https://www.cjoint.com/?0Byl0gmQd7i 
RQ. quelques plages ont été "nommées"

bonne suite

ccm81 · Answer

re

une solution nettement plus rapide 
https://www.cjoint.com/?0Bzk1mLkzv2 

bonne suite

Utilisateur anonyme · Answer

Nous venons de voir votre réponse et vous remercions grandement !!

Merci d'avoir répondu a nos interrogations. Nous allons étudier un peu plus en détails vos codes VBA. Si nous ne comprenons pas certains points pourriez vous répondre a quelques questions ? 

Merci encore pour le temps passez a nous aider !!

ccm81 · Answer

Et pour un grand nombre d'essais, on peut inhiber le rafraichissement d'écran à chaque essai, ça fait moins dynamique mais c'est beaucoup plus rapide (n = 30000 en 6 s)

Application.ScreenUpdating = False
For nuessai = 1 To n
.
.
    End If
  'Application.Calculate
Next nuessai
Application.ScreenUpdating = True

bonne suite

ccm81 · Answer

re 

on peut faire encore plus rapide (moins d'une s pour 30000 essais) en réalisant les tirages dans un tableau en RAM puis en transférant le tout sur la feuille après le dernier tirage.  

Private Sub btTresRapide_Click() 
Dim nuessai As Long, n As Long 
Dim I As Long 
Dim X As Double, Y As Double 
Dim T 
Dim liinf1 As Long, lisup1 As Long 
Dim hdeb, hfin 
Dim plage As String 
n = Range("n").Value 
ReDim T(1 To n, 1 To 4) 
I = 0 
hdeb = Now 
liinf1 = 1 
lisup1 = 1 
For nuessai = 1 To n 
  X = Rnd 
  Y = Rnd 
    If X * X + Y * Y < 1 Then 
      T(liinf1, 1) = X 
      T(liinf1, 2) = Y 
      liinf1 = liinf1 + 1 
      I = I + 1 
    Else 
      T(lisup1, 3) = X 
      T(lisup1, 4) = Y 
      lisup1 = lisup1 + 1 
    End If 
Next nuessai 
Range("essai").Value = n 
plage = "A" & lideb & ":D" & lideb + n - 1 
Range(plage) = T 
Range("pi").Value = 4 * I / n 
hfin = Now 
Range("t").Value = hfin - hdeb 
End Sub
bonne suite

Utilisateur anonyme · Answer

Bonsoir, 

Tout d'abord, merci pour votre précieuse aide!

Nous avons mis un peu de temps à comprendre et refaire le codage et certains problèmes persistent.

Je vous link notre fichier xls tel que nous le voulons. 
https://www.cjoint.com/?0CgagaDfX5C 
Il s'agit en fait de rajouter les deux colonnes "Nbessai" et "Pi" puis de les intégrer dans le code. Cependant, nous n'arrivons pas à situer notre erreur. Le deuxième graphique vierge serait en fait une courbe qui permettrait de montrer pour chaque essai la valeur approchée de PI en appuyant simplement sur le bouton 3.

De plus, en ce qui concerne la réduction du temps pour le nombre d'essais, nous avons essayé avec "Application.ScreenUpdating = False" mais dès que nous dépassons les 2000 essais, tout se met à planter. 

Pouvez-vous nous éclairer?

Merci d'avance.

ccm81 · Answer

bonjour  

je n'ai pas bien compris ce que tu veux, est ce que ça ressemble à ceci  
https://www.cjoint.com/?0Cgk7KqALl8   

quelques remarques  
RQ1. pour la rapidité, le fait de n'avoir qu'une série de données et de modifier la couleur de chaque point au fur et à mesure est très pénalisant. Il est préférable d'avoir 2 séries de données (une pour x²+y²<1 et une pour x²+y²>=1, chacune ayant sa couleur) voir les propositions des post 2, 4, 5  
RQ2. pour le plantage après 2000 points, c'est normal, vu que tes séries de données s'arrêtent à la ligne 2009 (soit N=1999) donc prolonges les  
RQ3. pour ces séries de données il est plus judicieux de les définir de façon 'dynamique' en fonction de N (je les ai nommé plageX et plageY voir insertion/nom/definir puis les données source)   

bonne suite

Méthode de Monté Carlo, pour le nbr Pi, Vba

7 réponses

Discussions similaires

Newsletters