Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Bonjour !
J'ai un problème a résoudre avec une macro mais je n'y connais pas grand chose en VBA.
Voila :
Je dois répartir un nombre aléatoirement entre plusieurs lignes entre 2 et 10. Avec dans chacune des lignes une valeur comprise entre 0 et 43.
Je donne un exemple:
Je rentre la valeur 172 dans une case
il faudrait répartir aléatoirement 172 dans les 6 lignes en dessous.
(par exemple 32 + 40 + 25 +37 + 23 + 15 dont la somme est égale a 172)
et que chaque case soit équiprobable
(la case 1 a autant de chance de recevoir 0 ou 43 que la 2 etc....).
Le même traitement effectué à la Sub 2 (Tata), ramène le temps d'éxécution à 16 secondes (Voir PJ) (mais nous ne sommes pas encore au niveau 1 de l'optimisation ...)
Code:
Sub tata()
Dim s%, i%, a(1 To 60000, 1 To 6) As Integer
Dim n As Long
Dim t As Single
Dim nbTirages As Variant
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
[B][COLOR=blue]With WorksheetFunction[/COLOR][/B] [B][COLOR=green]' Sans cette instruction, ajouter 6 secondes au temps total[/COLOR][/B]
For n = 1 To 60000
Do
s = 0
For i = 1 To [B][COLOR=red]5[/COLOR][/B]
a(n, i) = Int([B][SIZE=3][COLOR=blue].[/COLOR][/SIZE][/B]Min(44, (173 - s)) * Rnd)
s = s + a(n, i)
Next i
nbTirages = nbTirages + 1
Loop Until [B][COLOR=#ff0000]s <= 172 [/COLOR][COLOR=#0000ff]And s >= 129[/COLOR][/B]
[B][COLOR=#ff0000]a(n, 6) = 172 - s[/COLOR][/B]
Next n
[B][COLOR=blue]End With[/COLOR][/B]
[H1].Value = CLng(Round(Timer - t, 2) * 100) / 100
[A1:F60000] = a
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
[H2].Value = CLng(Round(Timer - t, 2) * 100) / 100
[H3] = Format(nbTirages - 60000, "# ###")
End Sub
A soenda :
Vos deux derniers messages m'ont donné l'occasion de creuser un peu la question.
J'ai étudié votre proposition de réduire le temps d'exécution en "soignant" la boucle Do... ...Loop. Vous réduisez effectivement le temps de recherche, mais je me suis rendu compte que vous avez changé de problème. En fait, vous tirez cinq nombres dont la somme est comprise entre 129 et 172. Cela revient à dire que, dès lors que vous avez tiré ces cinq nombres, vous êtes certain que si vous ajoutiez un sixième tirage, il amènerait nécessairement la somme à 172. En réalité, le sixième tirage vous amènera à ce résultat avec une probabilité de 1/44 :
Ayant, par exemple tiré 35, 28, 2, 42, 33, vous décidez que le suivant doit être 32. Mais si vous effectuez réellement un tirage vous sortirez tout aussi bien 0, 1, ..., 31, 33,..., 42, 43. Vous avez même 43 chances sur 44 qu'il en soit ainsi ! Bien sûr, si on procède à une succession de tirages, il arrivera nécessairement qu'on trouve le tirage 35, 28, 2, 42, 33, 32. Mais rien n'indique que ce tirage sera le premier où on aura trouvé 35, 28, 2, 42, 33 : il peut y avoir des milliers de tirages donnant une somme de 172 avant de tomber sur celui là. Donc, en adoptant ce point de vue, on abandonne l'idée de s'en remettre au hasard. Faisons-le un instant. Ayant trouvé les quatre nombres 35, 28, 2, 42 (somme 107), on voit qu'il manque 65 pour arriver au résultat. Il suffit alors de prendre un cinquième nombre quelconque entre 22 et 43 inclus pour être assuré de pouvoir compléter le tirage par un sixième nombre amenant la somme à 172. De proche en proche, on peut construire une procédure telle que, ayant réellement tiré aléatoirement les deux premiers nombres entre 0 et 43 inclus, on choisit les quatre suivants pour obtenir une somme égale à 172. C'est ce que fait la procédure suivante :
Code:
[COLOR="DarkSlateGray"]Sub alea_2v1_1_passe() [COLOR="SeaGreen"]'test_1_g()[/COLOR]
Dim s As Integer, u(1 To 60000, 1 To 6) As Long, n As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For n = 1 To 60000
u(n, 1) = Int(44 * Rnd)
u(n, 2) = Int(44 * Rnd): s = u(n, 1) + u(n, 2)
u(n, 3) = (43 - s + Abs(43 - s)) / 2 + Int(((45 + s - Abs(43 - s)) / 2) * Rnd): s = s + u(n, 3)
u(n, 4) = (86 - s + Abs(86 - s)) / 2 + Int(((2 + s - Abs(86 - s)) / 2) * Rnd): s = s + u(n, 4)
u(n, 5) = (129 - s + Abs(129 - s)) / 2 + Int((44 - Abs(129 - s)) * Rnd): s = s + u(n, 5)
u(n, 6) = 172 - s
Next n
ActiveSheet.Range("A1:F60000").Offset(1, 0).Value = u [COLOR="SeaGreen"]'ou autre destination[/COLOR]
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/COLOR]
Avec cette procédure, on trouve un réponse satisfaisante à chaque boucle.
(Remarque sur la programmation : tout cela se règle à coup de Min() et de Max(), mais ces fonctions, même appelées correctement comme vous l'indiquez dans un précédent message, sont très lentes. J'ai préféré utiliser des calculs plus rapides :
Code:
[COLOR="DarkSlateGray"](a + b - Abs(a - b)) / 2[/COLOR]
pour Min(a,b), et :
Code:
[COLOR="DarkSlateGray"](a + b + Abs(a - b)) / 2[/COLOR]
pour Max(a,b).) _
La procédure
Code:
[COLOR="DarkSlateGray"]Sub alea_2v1_5_passes() [COLOR="SeaGreen"]'test_1_h()[/COLOR]
Dim s As Integer, u(1 To 12000, 1 To 6) As Long, n As Long, p As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
With ActiveSheet [COLOR="SeaGreen"]'ou autre feuille[/COLOR]
For p = 1 To 60000 Step 12000
For n = 1 To 12000
u(n, 1) = Int(44 * Rnd)
u(n, 2) = Int(44 * Rnd): s = u(n, 1) + u(n, 2)
u(n, 3) = (43 - s + Abs(43 - s)) / 2 + Int(((45 + s - Abs(43 - s)) / 2) * Rnd): s = s + u(n, 3)
u(n, 4) = (86 - s + Abs(86 - s)) / 2 + Int(((2 + s - Abs(86 - s)) / 2) * Rnd): s = s + u(n, 4)
u(n, 5) = (129 - s + Abs(129 - s)) / 2 + Int((44 - Abs(129 - s)) * Rnd): s = s + u(n, 5)
u(n, 6) = 172 - s
Next n
.Range(.Cells(p, 1), .Cells(p + 11999, 6)).Offset(1, 0).Value = u [COLOR="SeaGreen"]'ou autre destination[/COLOR]
Next p
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/COLOR]
utilisant un tableau cinq fois plus petit est à peu près aussi rapide. On trouvera une variante de ces procédures sous le nom alea_2v2_1_passe() dans le classeur joint. Elle donne un meilleure apparence de "hasard" au résultat obtenu. _
Mais c'est très différent de tirer aléatoirement six nombres entre 0 et 43, dont la somme est exactement 172. Revenons-y.
Le principe est d'engendrer une suite de nombres tous tirés entre 0 et 43 inclus par Int(44 * Rnd). Dès que six nombres consécutifs de cette suite ont pour somme 172, on les enregistre. Ce qui donne :
Code:
[COLOR="DarkSlateGray"]Sub alea_6_1_passe() [COLOR="SeaGreen"]'test_1_a(), test_1_c()[/COLOR]
Dim s As Integer, u(1 To 60000, 1 To 6) As Long, n As Long
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
On Error GoTo garde
Do
s = s - a: a = Int(44 * Rnd): s = s + a: If s = 172 Then Error 11
s = s - b: b = Int(44 * Rnd): s = s + b: If s = 172 Then Error 11
s = s - c: c = Int(44 * Rnd): s = s + c: If s = 172 Then Error 11
s = s - d: d = Int(44 * Rnd): s = s + d: If s = 172 Then Error 11
s = s - e: e = Int(44 * Rnd): s = s + e: If s = 172 Then Error 11
s = s - f: f = Int(44 * Rnd): s = s + f: If s = 172 Then Error 11
Loop
garde:
n = n + 1
u(n, 1) = a
u(n, 2) = b
u(n, 3) = c
u(n, 4) = d
u(n, 5) = e
u(n, 6) = f
If n < 60000 Then Resume Next Else Resume sort
sort:
On Error GoTo 0
ActiveSheet.Range("A1:F60000").Offset(1, 0).Value = u [COLOR="SeaGreen"]'ou autre destination[/COLOR]
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/COLOR]
En reportant ces procédures dans le classeur que j'ai fourni précédemment, vous aurez une visualisation graphique des grandes différences que présentent les deux approches considérées ici.
Je vous remercie de m'avoir poussé à reprendre ce code pour l'accélérer et je suis, comme toujours, preneur de vos observations et de vos commentaires.
Dans le classeur joint, vous trouverez des variantes (notamment en utilisant un tableau plus petit) ainsi que des versions de test pour relever et comparer les temps d'exécution.
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.