Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
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....).
Bonjour Efreian et bienvenue 🙂,
Désolé si ma réponse est plus courte que prévu, mais Vista vient de me redémarrer l'ordi en giclant tout le beau texte que je t'avais écrit 😡...
En gros, Rnd() te fourni un aléatoire >0 et <1. Si tu le multiplie par 173 en prenat la partie entière (Int(Rnd()*173), tu récuppères un chiffre entre 0 et 172. Ensuite il va falloir générer un nombre multiplié par 173 - le premier résultat obtenu. Et ainsi de suite. De là à dire que c'est equiprobable, je te laisse juge 🙄...
Bon courage 😎
Un essai de création de liste de nombres avec différents paramètres aux limites modifiables :
1 -Nombre des nombres à tirer variable de 2 à 10 ;
2 -Valeurs des nombres entier : Afin que ces nombres soient équiprobables, ils sont tirés avec la même probabilité. Dans l'essai, le tirage aléatoire de ces nombres est réalisé selon une base identique mais modifiable (0 à 43 dans l'exemple).
3 -Somme des nombres modifiable (172 par exemple).
4-Tirage aléatoire actuel réalisé sans doublon.
Je n'ai pas trouvé de réponse satisfaisante à ce problème. Il n'y a bien sûr aucune difficulté à engendrer des suites de six entiers de 0 à 43 dont la somme est 172. La difficulté vient de la condition :
la case 1 a autant de chance de recevoir 0 ou 43 que la 2 etc....
Je comprends cela ainsi : Sur un grand nombre de tirages, 0 sera aussi probable dans n'importe laquelle des six positions.
43 sera aussi probable dans n'importe laquelle des six positions.
Mais on n'exige pas que, sur un grand nombre de tirages, 0 soit aussi probable que 43 en première position. Ni aussi probable en deuxième position, etc..
S'il en est ainsi, la procédure de CBernardT donne probablement une réponse correcte.
La proposition de soenda est assez différente et ne donnera pas une égale probabilité de trouver un nombre donné dans chacune des six positions.
Quelle est la bonne interprétation ? Je n'en sais rien.
A titre d'étude, j'ai écrit les deux procédures suivantes :
Code:
[COLOR="DarkSlateGray"]Sub toto()
Dim s As Long, i As Long, a(1 To 6) As Long
Dim n As Long
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For n = 1 To 60000
Do
s = 0
For i = 1 To 6
[COLOR="Red"]a(i) = Int(44 * Rnd)[/COLOR]
s = s + a(i)
Next i
Loop Until s = 172
Range(Cells(n, 1), Cells(n, 6)).Value = a
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
[H1].Value = CLng(Round(Timer - t, 2) * 100) / 100
End Sub[/COLOR]
Code:
[COLOR="DarkSlateGray"]Sub tata()
Dim s As Long, i As Long, a(1 To 6) As Long
Dim n As Long
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For n = 1 To 60000
Do
s = 0
For i = 1 To 6
[COLOR="Red"]a(i) = Int(Application.Min(44, (173 - s)) * Rnd)[/COLOR]
s = s + a(i)
Next i
Loop Until s = 172
Range(Cells(n, 1), Cells(n, 6)).Value = a
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
[H1].Value = CLng(Round(Timer - t, 2) * 100) / 100
End Sub[/COLOR]
Elles ne diffèrent que par les lignes écrites en rouge, et elles traduisent les deux points de vue.
Elles engendrent chacune 60000 séries.
Le classeur comporte un tableau de comptage des occurrences de chaque nombre dans chaque position qui permet d'avoir une idée de la répartition. (Des représentations graphiques aident à la visualisation.)
Bien entendu, je joins le classeur vide. (Les procédures étant exécutées, le classeur pèse environ 8_Mo.) Il faut exécuter les deux procédures pour se rendre compte du résultat.
La première est assez rapide (une vingtaine de secondes), la deuxième prend plus de temps (7 à 8 minutes chez moi). Mais le résultat est instructif...
Une autre approche est possible : sur une grande série de tirages, chacune des séries possibles est obtenue "équiprobablement". Mais ça, je ne sais pas faire... Si quelqu'un à des lumières...
Comme les Sub de Roger sont très instructives mais un peu longues à l'éxécution, je me suis permis une petite modification du code de la Sub 1 (à titre d'exemple) qui divise le temps d'exécution par 2
Code:
Sub toto()
Dim s As Long, i As Long, [COLOR=blue][B]a(1 To 60000, 1 To 6)[/B][/COLOR] As Long
Dim n As Long
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For n = 1 To 60000
Do
s = 0
For i = 1 To 6
[B][COLOR=blue]a(n, i)[/COLOR][/B] = Int(44 * Rnd)
s = s + [B][COLOR=blue]a(n, i)[/COLOR][/B]
Next i
Loop Until s = 172
[B][COLOR=seagreen]' Range(Cells(n, 1), Cells(n, 6)).Value = a - Mis en commentaire[/COLOR][/B]
Next n
[B][COLOR=blue][A1:F60000] = [/COLOR][COLOR=red]a [/COLOR][/B][B][COLOR=red] ' DESOLE, J'AI MELANGE LES NOMS DE VARIALES ([/COLOR][/B][B][COLOR=red]Je suis nul !)[/COLOR][/B]
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
[H1].Value = CLng(Round(Timer - t, 2) * 100) / 100
End Sub
Merci d'avoir repris ce code. Il est effectivement un peu long à exécuter. La correction accélère l'exécution, mais au premier essai, elle ne renvoie rien. Je n'ai pas encore pris le temps de l'analyser pour trouver la cause de ce résultat inattendu. Je le ferai demain.
J'ai procédé à vingt essais de chacune des procédures. Le temps moyen a été de 22.92_s (respectivement 21.80_s) pour l'ancienne procédure (resp. la procédure corrigée) ; soit un gain de temps légèrement inférieur à 5_%.
Comment avez-vous fait pour diviser le temps d'exécution par 2_? Vous avez piqué ma curiosité...
De nouveaux tests effectués aujourdhui, confirment les résultats que j'ai obtenu hier pour la Sub 1 (toto).
Pour cette Sub, le temps d'exécution est bien divisé par 2.
Par contre, pour la Sub 2 (Tata), que je n'avais pas testé hier, le gain est quasi-inexistant.
Pour cette Sub, j'obtiens les mêmes résultats que Roger.
De nouveaux tests effectués aujourdhui, confirment les résultats que j'ai obtenu hier pour la Sub 1 (toto).
Pour cette Sub, le temps d'exécution est bien divisé par 2.
Par contre, pour la Sub 2 (Tata), que je n'avais pas testé hier, le gain est quasi-inexistant.
Pour cette Sub, j'obtiens les mêmes résultats que Roger.
Merci de suivre la discussion.
Il m'est impossible de reproduire vos résultats et je ne parviens pas à trouver pour quelle raison. J'ai vu que vous n'utilisez pas Excel2003 (grâce aux images). Est-ce un raison possible ? J'ai suspecté qu'un tableau de 360_000 cellules était peut-être un peu gros pour mon matériel. Pour m'en assuré, j'ai découpé le travail en travaillant avec un tableau dix fois plus petit et en itérant la procédure dix fois. Le gain est infime : la saturation de la mémoire semble donc à écarter.
Bref, je n'ai rien trouvé d'autre...
Par contre, un gain de plus de 25% du temps d'exécution est possible sur la base de la procédure que vous avez corrigée. En observant que la boucle Do... ...Loop est exécutée environ 11_600_000 fois, on voit que son optimisation peut être très bénéfique. Ce qui donne :
Code:
[COLOR="DarkSlateGray"]Sub toto_2()
Dim a(1 To 60000, 1 To 6) As Integer, n As Long
Dim d As Integer, e As Integer, f As Integer, g As Integer, h As Integer, i As Integer
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For n = 1 To 60000
Do
d = Int(44 * Rnd)
e = Int(44 * Rnd)
f = Int(44 * Rnd)
g = Int(44 * Rnd)
h = Int(44 * Rnd)
i = Int(44 * Rnd)
Loop Until d + e + f + g + h + i = 172
a(n, 1) = d
a(n, 2) = e
a(n, 3) = f
a(n, 4) = g
a(n, 5) = h
a(n, 6) = i
Next n
[A1:F60000] = a
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Cells(Rows.Count, 20).End(xlUp).Offset(1, 0).Value = CLng(Round(Timer - t, 2) * 100) / 100
End Sub[/COLOR]
Le temps moyen d'exécution chute de 21,32s à 16,96s (moyenne de vingt exécutions). Voulez-vous me dire si vous observez le même gain (en proportion, non en temps puisque l'ancienne procédure est déjà beaucoup plus rapide chez vous)_?
Pour comparer avec l'exécution "en tranches" que j'évoquais plus haut, j'ai testé ceci :
Code:
[COLOR="DarkSlateGray"]Sub toto()
Dim a(1 To 6000, 1 To 6) As Long, n As Long, p As Long
Dim d As Integer, e As Integer, f As Integer, g As Integer, h As Integer, i As Integer
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For p = 1 To 60000 Step 6000
For n = 1 To 6000
Do
d = Int(44 * Rnd)
e = Int(44 * Rnd)
f = Int(44 * Rnd)
g = Int(44 * Rnd)
h = Int(44 * Rnd)
i = Int(44 * Rnd)
Loop Until d + e + f + g + h + i = 172
a(n, 1) = d
a(n, 2) = e
a(n, 3) = f
a(n, 4) = g
a(n, 5) = h
a(n, 6) = i
Next n
Range(Cells(p, 1), Cells(p + 5999, 6)).Value = a
Next p
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Cells(Rows.Count, 19).End(xlUp).Offset(1, 0).Value = CLng(Round(Timer - t, 2) * 100) / 100
End Sub[/COLOR]
C'est, chez moi, à peine plus rapide (gain de l'ordre de 1% sur vingt essais), mais la taille du tableau étant dix fois plus petite, c'est peut-être intéressant avec une machine un peu courte en mémoire. A voir...
Mais je me rends compte que l'auteur du problème est bien discret. J'espère qu'on ne cherche pas pour rien...
J'ai effectué les tests avec tes modifications et j'observe le même gain en proportion.
MAIS !
Ayant refait les tests avec la Sub1 (toto) et constaté des performences en baisse (15 secondes),
j'ai revu le code ... et cette fois la version avec la boucle est au moins aussi rapide (1,05 à 1,10).
A mon avis ce résultat contradictoire est dû à une gestion peu efficace du test d'arrêt de la boucle.
En effet en fonction de l'heure à laquelle est lancée la Sub, la boucle rejettera plus ou moins de tirages,
et par conséquent, dépensera plus ou moins de temps.
Vois ci-dessous, la Sub1 (toto) avec un test d'arrêt plus efficace car rejetant moins de tirages
Temps d'éxécution pour 60 000 items = 1,20 s.(Voir PJ)
Code:
Sub toto()
Dim s%, i%, a(1 To 60000, 1 To 6) As Integer
Dim n As Long
Dim t As Single
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Randomize
For n = 1 To 60000
Do
s = 0
For i = 1 To [B][COLOR=red]5[/COLOR][/B]
a(n, i) = Int(44 * Rnd)
s = s + a(n, i)
Next i
Loop Until [COLOR=red][B]s <= 172 [/B][/COLOR][COLOR=blue][B]And s >= 129[/B][/COLOR]
[B][COLOR=red]a(n, 6) = 172 - s[/COLOR][/B]
Next n
[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
End Sub
- 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.
