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

patricktoulon · 17 Octobre 2023

merci laurent
mais j'ai oublié un detail
UNE SEULE BOUCLE !!!
et oui sinon serait pas un défi
ps: j'ai déjà trouvé entre temp une solution toute bête, mais je reste ouvert

ensuite le defit sera entre min et max et les niemes premiers
et TOUJOURS en une seule boucle
j'arrête pas de le dire quand je pose une question c'est jamais simple qu'il n'y parait

Dudu2 · 17 Octobre 2023

Bonjour,

Je sais pas trop comment ça marche car j'ai pas creusé les détails, mais ça le fait.

VB:

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

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

laurent950 · 17 Octobre 2023

Bonsoir @patricktoulon

en mode usine à gaz

VB:

Function randomListNumberRecursive(list() As String, Optional mini As Integer, Optional maxi As Integer, Optional n As Integer) As String()
        If n = maxi - mini + 1 Then
        randomListNumberRecursive = list
    Else
        ReDim Preserve list(n)
        Dim v As Integer
        Dim exists As Boolean
        Do
            v = Int((maxi - mini + 1) * Rnd) + mini
            exists = False
            For i = 1 To n
                If list(i) = CStr(v) Then
                    exists = True
                    Exit For
                End If
            Next
        Loop While exists
        list(n) = v
        randomListNumberRecursive = randomListNumberRecursive(list, mini, maxi, n + 1)
    End If
End Function


Sub test()
    Dim minVal As Integer, maxVal As Integer, n As Integer, list() As String
    n = 0
    minVal = 6 ' Remplacez par votre valeur minimale
    maxVal = 25 ' Remplacez par votre valeur maximale
    Dim result() As String
    result = randomListNumberRecursive(list, minVal, maxVal, n)
    MsgBox Join(result, vbCrLf)
End Sub

patricktoulon · 17 Octobre 2023

RE
Bonsoir @Dudu2 oui
c'est pour quoi "-3"?

perso j'avais trouvé le truc tout bête
on boucle plus de 1 à .. mais du lbound à....
et on redim preserve(min to max )

VB:

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

Sub test2()
    Cells(1, 1).Resize(20) = Application.Transpose(randomListNumber2(10, 30))
End Sub

patricktoulon · 17 Octobre 2023

@laurent950
BOURRIN!!!!!!!
et en plus il y a deux boucles une do/loop et une for/next

Dudu2 · 17 Octobre 2023

c'est pour quoi "-3"?

Ben le mini.
Rien ne dit dans ton énoncé que le mini doit être positif.

VB:

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

patricktoulon · 17 Octobre 2023

re
c'est pas mal du tout @Dudu2 on va même dans le negatif
edit: oui j'ai compris après

Dudu2 · 17 Octobre 2023

@laurent950,
Tu as échappé au gros cabot préféré de @patricktoulon ! C'est déjà ça.

Dudu2 · 17 Octobre 2023

c'est pas mal du tout @Dudu2 on va même dans le negatif

Je me suis pas fatigué à comprendre.
J'ai repris ton code et simplement adapté à un tableau décalé par mini.

laurent950 · 17 Octobre 2023

laurent950 à dit:
en mode usine à gaz

J'avais précisé en mode Usine à Gaz hi hi hi ! Patrick est prévisible ;-)
le système récursif est intéressant du moins aussi

patricktoulon · 17 Octobre 2023

allez on avance
on passe au 3eme argument maintenant le nombre d'items en min et max
version patricktoulon(ne gère pas le negatif)

VB:

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

Sub test2()
    Cells(1, 1).Resize(10) = Application.Transpose(randomListNumber2(10, 30, 10))
End Sub

il fallait y penser au redim >1
version @Dudu2 adaptée

VB:

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

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

@laurent950
ben c'est pas que je prévisible a faire des petits exercices comme ça autant chercher un peu plus loin que ce qui parait simple mais qui ne l'est pas laurent tu en fait la démo

Dudu2 · 17 Octobre 2023

Y aurait-il une autre façon de faire ?
Sûrement ! A vous de jouer.
Mais cette méthode est très subtile et efficace car elle utilise à la fois l'indice et le Rnd pour valoriser 2 valeurs en 1 passage.

mapomme · 17 Octobre 2023

Bonsoir à tous,

Il me semble qu'on peut éviter tous ces if qui alourdissent considérablement le code (voire ralentissent l'exécution) avec une simple boucle de remplissage.

VB:

Function randomListNumber(mini, maxi)
Dim i&, n&, k&, aux
   ReDim t(mini To maxi): n = maxi - mini + 1
   Randomize
   For i = mini To maxi: t(i) = i: Next
   For i = mini To maxi: k = mini + Int(Rnd * n): aux = t(i): t(i) = t(k): t(k) = aux: Next
   randomListNumber = t
End Function

patricktoulon · 17 Octobre 2023

Je sais pas trop comment ça marche car j'ai pas creusé les détails, mais ça le fait.

le fonctionnement est simple
à l'origine ma fonction crée un array dans l'ordre (1,2,3,4,5.....)comme @mapomme vient de le démontrer
ensuite je boucle for i= 1 to max .
a chaque tour je choisi un item(rnd*...)
et j’intervertis l'item(i) et l'item(rnd)

ce soir l'exercice et de se servir de cet array mais vide au départ
problème dans la boucle on peut tomber plusieurs fois dessus un item et si il a déja été utilisé on va avoir un doublons quand on va intervertir et c'est la que les if t(i) ou t(x)="" servent a alimenter l'item ou pas avant intervertir
voila voila

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

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires