Méthode de Monté Carlo, pour le nbr Pi, Vba
Résolu
Utilisateur anonyme
-
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Méthode de Monté Carlo, pour le nbr Pi, Vba
- Excel compter cellule couleur sans vba - Guide
- Incompatibilité de type vba ✓ - Forum VB / VBA
- Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
- Dépassement de capacité vba ✓ - Forum Excel
- Super pi - Télécharger - Optimisation
7 réponses
Bonjour
un essai (un peu) simplifié
https://www.cjoint.com/?0Byl0gmQd7i
RQ. quelques plages ont été "nommées"
bonne suite
un essai (un peu) simplifié
https://www.cjoint.com/?0Byl0gmQd7i
RQ. quelques plages ont été "nommées"
bonne suite
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)
bonne suite
Application.ScreenUpdating = False
For nuessai = 1 To n
.
.
End If
'Application.Calculate
Next nuessai
Application.ScreenUpdating = True
bonne suite
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.
bonne suite
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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 !!
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 !!
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.
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.
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
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