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
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

XLDnaute Barbatruc
Une autre méthode en 2 boucles consisterait à représenter les nombres dans un tableau de booléen et de faire un Rnd sur le nombre de chiffres restants à tirer au sort puis parcourir le tableau de boolean pour trouver le chiffre du Rnd.
Mais ça reste assez basique et toujours avec une 2ème boucle nécessaire.
 

patricktoulon

XLDnaute Barbatruc
regarde laurent
dès le premier lancement de ta fonction
1697573644775.png

c'est sans appel
je repete donc le principe de base est d'avoir une liste dans l'ordre préétablie (@mapomme) ou dynamique(patricktoulon) et ensuite selectionner 2 index autant de fois que la boucle tourne et les intervertir
tu a ainsi l'assurance de pas avoir de doublons c'est impossible avec cette méthode d'ailleurs
et combien même un item serait selectionner plusieurs fois dans la boucle
voila c'est ca que je voulais dire par méthode particulière ;)
 

Dudu2

XLDnaute Barbatruc
Du coup, après avoir pu faire un LBound négatif, je reformule le truc légèrement simplifié.
VB:
Function randomListNumber(mini, maxi)
   Dim i&, X&, temp
   Randomize
    ReDim t(mini To maxi)
    For i = LBound(t) To UBound(t)
        If t(i) = "" Then t(i) = i
        X = Int((maxi - mini + 1) * Rnd + mini)
        If t(X) = "" Then t(X) = X
        temp = t(i)
        t(i) = t(X)
        t(X) = temp
    Next
    randomListNumber = t
End Function

Sub test()
    MsgBox Join(randomListNumber(-3, 4), vbCrLf)
End Sub
 

laurent950

XLDnaute Barbatruc
oui mais tu ne gère pas les doublons me semble t il
Re @patricktoulon

Tu as raison un autres essaie, toujours en une seule Boucle, le on error resume next est l'astuce pour créer l'erreur dans il y a un doublon, si erreur j'efface l'erreur et je retranche 1 case du tableau a i

VB:
Function randomListNumber3(mini, maxi, nb) As String()
' Gestion des doublons
    Dim Var As String
    Dim coll As New Collection
    Dim i As Long, result() As String
    ReDim result(1 To nb)
    Randomize
    For i = 1 To nb
    Var = CStr(Int((maxi - mini + 1) * Rnd) + mini)
    On Error Resume Next ' Pour évité une fonction de test
    coll.Add Item:=Var, Key:=Var
        If Err = 0 Then
            result(i) = Var
        Else
            On Error GoTo 0
            i = i - 1
        End If
    Next
    randomListNumber3 = result
End Function

Sub test()
    MsgBox Join(randomListNumber3(-3, 20, 10), vbCrLf)
End Sub
 

Simply

XLDnaute Occasionnel
Hi


VB:
Sub testNew()
    MsgBox Join(Application.Transpose([SortBy(Sequence(30), RandArray(30))]), vbCr)
End Sub
 

laurent950

XLDnaute Barbatruc
Merci Patrick,
j'ai saisie le principe maintenant c'est très astucieux félicitation pour ce code et pour ton explication très détaillé et qui aide beaucoup a comprendre.
Encore merci pour ton partage de connaissance c'est vraiment super Patrick
Laurent
 

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 130
Membres
112 667
dernier inscrit
foyoman