XL 2013 crer une liste de nombres aleatoires entre un min et un max avec une fonction VBA méthode particulière

patricktoulon · 17 Octobre 2023

Bonsoir à tous
c'est juste pour le fun
perso pour créer une liste de nombres aléatoires je préfère mélanger une liste ordonné(dans l'ordre au départ)
on a la garantie de non doublons et c'est largement plus rapide
sauf que là l'exercice est encore plus intéressant
je demarre avec une liste (un array vide(sans valeur)
alors pour faire de 1 à max ca va ,mais pour faire de min à max ca devient compliqué avec cette méthode tout du moins sans transformé un code très simple à la base en en centrale nucléaire

voici la méthode avec un array vide sans doublons et de 1 à max

VB:

Function randomListNumber(maxi)
   Dim i&, X&, temp
   Randomize
    ReDim t(1 To maxi)
    For i = 1 To maxi
        If t(i) = "" Then t(i) = i
        temp = t(i)
        X = 1 + Int((Rnd * (maxi - 1)))
        If t(X) = "" Then t(X) = X
        t(i) = t(X)
        t(X) = temp
    Next
    randomListNumber = t
End Function

Sub test()
    MsgBox Join(randomListNumber(30), vbCrLf)
End Sub

Dudu2 · 19 Octobre 2023

c'est super simple à comprendre en fait

Si je comprends parfaitement le mécanisme pour éviter les doublons, et bien je ne le comprends pas le caractère 100% aléatoire de la liste. Je ne suis probablement pas assez intelligent.

Alors je pose la question en termes mathématiques pour ceux qui savent le faire.
Quelle est la probabilité d'avoir 2 listes (puis 3 puis 4) identiques dans 3629 tirages (10! / 1000) aléatoires de 10 nombres ?
Je fais les tests pour avoir un résultat expérimental. Je dois partir et donnerai des résultats plus complets cet aprem avec les différentes méthodes. Un premier et unique résultat avec la méthode @Dranreb me donne 359 listes similaires pour 3629 tirage. Normal ?

Edit: le compte est exagéré, faudra que je corrige pour ne pas compter B=C quand A=B et A=C

Dranreb · 19 Octobre 2023

Spécifiez une graine différente à chaque fois, ou ne refaites peut être pas de Randomize, faites en un une seule fois au début.

patricktoulon · 19 Octobre 2023

re
oui le randomize c'est une fois pas 36

Alors je pose la question en termes mathématiques pour ceux qui savent le faire.
Quelle est la probabilité d'avoir 2 listes (puis 3 puis 4) identiques dans 3629 tirages (10! / 1000) aléatoires de 10 nombres ?

entre 10 et 1000 c'est ça ?
et comment peux tu prétendre avoir un résultat en gardant en tête le contexte aléatoire
tu sais combien ça fait de combi de (10 nombre sur 1000)+les permutations
tu chasse le feu follet là

je sens un beau message"dépassement de capacité " moi

patricktoulon · 19 Octobre 2023

re
allez on ressort les archives

VB:

Sub test()
    MsgBox NbCombi(10, 10) & " combinaison possibles"
End Sub
Sub test2()
    MsgBox NbCombiPermut1(10, 10) & " (combinaison /permutations) possibles"
End Sub
Function NbCombiPermut1(Base#, N#) As Double
'FORMULE PATRICKTOULON Developpez.com
    Dim Nb#, i#: Nb = Base
    For i = 1 To N - 1: Nb = Nb * (Base - i): Next: NbCombiPermut1 = Nb
End Function

Function NbCombiPermut4(Base#, N#) As Double
'FORMULE PATRICKTOULON Developpez.com
    Dim res#, x#, y#
    x = Application.Combin(Base, N)
    y = Evaluate("Fact(" & N & " )*Combin(" & N & "," & N & ")")
    NbCombiPermut4 = Val(x * y)
End Function

Function NbCombiPermut3(Base#, N#) As Double
'formule de Menhir Developpez.com
    Dim res#
    res = Evaluate("Fact(" & Base & ")/Fact(" & Base & "-" & N & ")")
    NbCombiPermut3 = res
End Function

Function NbCombiPermut2(Base#, N#) As Double
'formule de Menhir Developpez.com
    Dim res#
    res = Evaluate("Fact(" & N & ")*Combin(" & Base & "," & N & ")")
    NbCombiPermut2 = res
End Function

Function NbCombi(Base#, N#)
'FORMULE PATRICKTOULON Developpez.com
'NbCombi = Evaluate("COMBIN(" & Base & "," & N & ")")' avec evaluate
    NbCombi = WorksheetFunction.Combin(Base, N)    ' avec worksheetfunction
End Function

dysorthographie · 19 Octobre 2023

Personnellement j'utilise une collection et je remove a chaque tirage

patricktoulon · 19 Octobre 2023

dysorthographie à dit:
Personnellement j'utilise une collection et je remove a chaque tirage

Bonjour Robert
un exemple ?

Dudu2 · 19 Octobre 2023

Spécifiez une graine différente à chaque fois, ou ne refaites peut être pas de Randomize, faites en un une seule fois au début.

En effet ça change la donne avec en plus la correction pour ne pas compter les doublons multiples plusieurs fois. Plusieurs tests sur les 3000 tirages:

Résultat 2 doublons
Résultat 2 doublons
Résultat 1 doublon
Résultat 1 doublon
Résultat 1 doublon
Résultat 0 doublon

Ça pourrait être compatible avec un tirage aléatoire.
Je vais quand même faire quelques tests supplémentaires avec la méthode @Dudu2 sur ce tirage, et aussi avec des tirages plus importants

Dudu2 · 19 Octobre 2023

Même test avec la méthode @Dudu2:

Résultat: 3 doublons
Résultat: 1 doublon
Résultat: 1 doublon
Résultat: 3 doublons
Résultat: 4 doublons
Résultat: 2 doublons

Alors sur ces tests, c'est la méthode qui tire au sort tous les numéros qui est la plus soupçonnable de ne pas être 100% aléatoire !

patricktoulon · 19 Octobre 2023

RE
j'ai testé ta multiple avec randomListNumber2
1 doublons la 1 ère fois trouvé à 820/3628
2 doublons la 2d fois 740 et 930 sur 3628
purée c'est long on peut faire plus rapide comme test

Dudu2 · 19 Octobre 2023

Tous les tests montrent que toutes les méthodes génèrent une liste purement aléatoire avec un nombre de doublons à peu près équivalents sur un nombre donné de tirages.

Dudu2 · 19 Octobre 2023

purée c'est long on peut faire plus rapide comme test

Il faut comparer chaque liste (sauf les listes déjà identifiées comme doublons) aux autres listes.
Les valeurs sont en table mémoire.
Si tu as mieux...

patricktoulon · 19 Octobre 2023

bon alors j'ai refait les chose plus rapide
test méthode @Dranreb je suis allé jusqu'a 4 doublons au premier tirage

test version Dudu2

test version patrick

VB:

Sub testpatricktoulon()
    Dim i&
    ReDim t(1 To 3628, 1 To 1)
    Cells(1, 1).Resize(3628).ClearContents
    For i = 1 To 3628
        t(i, 1) = Join(randomListNumber2(1, 10, False), "-")
    Next
    Cells(1, 1).Resize(3628) = t
    ActiveSheet.Range("$A$1:$A$3628").RemoveDuplicates Columns:=1, Header:=xlNo
    MsgBox 3628 - Cells(Rows.Count, "A").End(xlUp).Row & " doublons trouvé"
End Sub
Sub testdudu2()
    Dim i&
    ReDim t(1 To 3628, 1 To 1)
    Cells(1, 1).Resize(3628).ClearContents
    For i = 1 To 3628
        t(i, 1) = Join(randomListNumber(1, 10, False), "-")
    Next
    Cells(1, 1).Resize(3628) = t
    ActiveSheet.Range("$A$1:$A$3628").RemoveDuplicates Columns:=1, Header:=xlNo
    MsgBox 3628 - Cells(Rows.Count, "A").End(xlUp).Row & " doublons trouvé"
End Sub

Sub testDranreb()
    Dim i&
    ReDim t(1 To 3628, 1 To 1)
    Cells(1, 1).Resize(3628).ClearContents
    For i = 1 To 3628
        t(i, 1) = Join(randomListNumber3(1, 10, False), "-")
    Next
    Cells(1, 1).Resize(3628) = t
    ActiveSheet.Range("$A$1:$A$3628").RemoveDuplicates Columns:=1, Header:=xlNo
    MsgBox 3628 - Cells(Rows.Count, "A").End(xlUp).Row & " doublons trouvé"
End Sub

patricktoulon · 19 Octobre 2023

quand on passe avec des series de 1 à 20 il n'y a plus de doublons

patricktoulon · 19 Octobre 2023

en tout cas plus rapide que ça en pur vba ça va être dur
il semblerait en effet que randomize provoque beaucoup plus de doublons

Dudu2 · 19 Octobre 2023

Je le redis, ma suspicion sur les 2 méthodes à indice dont la logique aléatoire m'échappe toujours n'était pas justifiée.
Tous les tests montrent que toutes les méthodes génèrent une liste purement aléatoire avec un nombre de doublons à peu près équivalents en moyenne sur un nombre donné de tirages.

XL 2013 crer une liste de nombres aleatoires entre un min et un max avec une fonction VBA méthode particulière

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

Dudu2

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Pièces jointes

Discussions similaires