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

[patricktoulon]

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

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]

de rien Laurent j'espère que c'est plus clair pour toi

 

[patricktoulon]

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

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

@laurent950 ca va par ce que ca marche mais tu a autant de tour supplémentaires de boucle I que de doublons éventuellement survenus
avec ma méthode tu ubound(tonarray) tours de boucle sans doublons et c'est tout

 

[laurent950]

Oui et avec ton explication, c'est effectivement devenu plus clair. Je te remercie pour ta précision dans l'explication, car cela me permet d'apprendre également. En fait, je continue d'enrichir mes connaissances un peu plus chaque jour.

Maintenant j'ai compris cette fois-ci, c'est très astucieux, je vais consigné cette méthode qui est très efficace. Merci Encore Patrick

 

[patricktoulon]

pour info ca marche avec le texte aussi
exemple

Function unorderedList(t)
Randomize
For i = LBound(t) To UBound(t)
X = Int(Rnd * UBound(t))
temp = t(i): t(i) = t(X): t(X) = temp
Next
unorderedList = t
End Function

Sub test()
a = Split("a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y", ",")
MsgBox Join(unorderedList(a), ",")
End Sub

et on peu s'en servir de matrice pour x array
exemple

Function matrice(t)
 ReDim q(1 To UBound(t) + IIf(LBound(t) = 0, 0, 0))
 For i = LBound(q) To UBound(q)
        If q(i) = "" Then q(i) = i
        X = 1 + Int(Rnd * UBound(q))
        If q(X) = "" Then q(X) = X
        temp = q(i)
        q(i) = q(X)
        q(X) = temp
    Next
matrice = q
End Function



Sub testmatrice()
a = Split("jean,paul,pierre,kevin,laurent,bernard", ",")
b = Array(18, 25, 41, 12, 38, 43)
c = matrice(a)

a = Application.Index(a, 0, c)
b = Application.Index(b, 0, c)

MsgBox Join(a, ",") & vbCrLf & Join(b, ",")
End Sub

 

[Dudu2]

En fait cet algorithme, il est en même temps génial et un peu bizarre. Il est macronien !
Car les nombres résultants sont composés à la fois de l'indice de la boucle et du nombre aléatoire qui sert aussi d'indice pour éviter les doublons mais qui lui, au-moins, est vraiment aléatoire contrairement à l'indice.

J'ai codé le truc dont j'avais parlé, certes avec 2 boucles et certainement plus long mais où là, TOUS les nombres résultants sont issus du tirage aléatoire.

Sub test()
    MsgBox Join(randomListNumber(1, 7), vbCrLf)
End Sub

Function randomListNumber(mini As Long, maxi As Long)
    Dim i As Long
    Dim b As Long
    Dim k As Long
    Dim x As Long
    Dim tb() As Boolean
    Dim t() As Variant
  
    Randomize
    ReDim t(mini To maxi)
    ReDim tb(mini To maxi)
  
    For i = LBound(t) To UBound(t)
        x = Int((maxi - (i - LBound(t)) - mini + 1) * Rnd + mini)
        k = mini - 1
        For b = LBound(tb) To UBound(tb)
            If Not tb(b) Then k = k + 1
            If k = x Then Exit For
        Next b
        t(i) = b
        tb(b) = True
    Next i
    randomListNumber = t
End Function

Edit: mais pas utilisable au-delà de 10.000 items alors que l'autre est imbattable sur la rapidité.

 

[Dudu2]

Sinon, sur le même principe où tous les nombres sont issus du tirage aléatoire, mais codé d'une manière différente, voici un autre code qui lui est aussi très rapide.

Sub test()
    MsgBox Join(randomListNumber(1, 100000), vbCrLf)
End Sub

Function randomListNumber(mini As Long, maxi As Long)
    Dim i As Long
    Dim x As Long
    Dim tt() As Long
    Dim t() As Variant
   
    Randomize
    ReDim t(mini To maxi)
    ReDim tt(mini To maxi)
   
    For i = mini To maxi
        tt(i) = i
    Next i
   
    For i = LBound(t) To UBound(t)
        x = Int((maxi - (i - LBound(t)) - mini + 1) * Rnd + mini)
        t(i) = tt(x)
        tt(x) = tt(UBound(tt))
        If UBound(tt) > 1 Then ReDim Preserve tt(1 To UBound(tt) - 1)
    Next i
    randomListNumber = t
End Function

 

[Dudu2]

Oops, supprimé par erreur.
Je disais donc, le rêve de @patricktoulon d'une seule boucle réalisé avec tous les nombres tirés au sort ! (Simplement dérivé du code précédent où il y avait une boucle d'initialisation)

Sub test()
    Dim t() As Variant
    Dim i As Long
    Dim k As Long
    Dim Dupe As Boolean
 
    Const Mini = -3
    Const Maxi = 4
 
    t = randomListNumber(Mini, Maxi)
    If Maxi - Mini + 1 > 30 Then GoTo NoDupeTest
 
    For i = LBound(t) To UBound(t) - 1
        For k = i + 1 To UBound(t)
            If t(i) = t(k) Then Exit For
        Next k
        If k <= UBound(t) Then Exit For
    Next i
    If i <= UBound(t) - 1 Then Dupe = True
 
    MsgBox Join(t, vbCrLf) & vbCrLf & "Dupe = " & Dupe
    Exit Sub

NoDupeTest:
    MsgBox Join(t, vbCrLf) & vbCrLf
End Sub

Function randomListNumber(Mini As Long, Maxi As Long)
    Dim i As Long
    Dim x As Long
    Dim tt() As Variant
    Dim t() As Variant
 
    Randomize
    ReDim t(Mini To Maxi)
    ReDim tt(Mini To Maxi) 
    
    For i = LBound(t) To UBound(t)
        x = Int((UBound(tt) - Mini + 1) * Rnd + Mini)
        If IsEmpty(tt(x)) Then t(i) = x Else t(i) = tt(x)
        If IsEmpty(tt(UBound(tt))) Then tt(x) = UBound(tt) Else tt(x) = tt(UBound(tt))
        If UBound(tt) > Mini Then ReDim Preserve tt(Mini To UBound(tt) - 1)
    Next i
    randomListNumber = t
End Function

Algorithme très rapide car je pense que le Redim Preserve en réduction de -1 ne génère pas de relocalisation mémoire.

 

[patricktoulon]

re
et ben dis donc il est a fond le dudu
Alors je reviens sur ce que tu a dis
je te cite

Sinon, sur le même principe où tous les nombres sont issus du tirage aléatoire, mais codé d'une manière différente, voici un autre code qui lui est aussi très rapide.

en fait c'est là ou tu fait erreur tout du moins dans ton interprétation
avec ma méthode tout les items sont aléatoires aussi
puisque ce n'est pas les nombre qui compte finalement c'est les index qui sont dans une boucle for i non pas déplacé mais interverti

1. pas besoins de contrôler les doublons
2. pas besoins de contrôler si un index est déjà passé
3. le redim preserve dès le départ me permet d’être en mini negatif
4. c'est la garantie d'un code minimal et pérenne
5. c'est aussi la garantie de non doublons forcement

ps:Je disais donc, le rêve de @patricktoulon d'une seule boucle réalisé avec tous les nombres tirés au sort !

tu croyais vraiment que je n'allais pas la voir la 2d boucle

For i = LBound(t) To UBound(t) - 1
        For k = i + 1 To UBound(t)
            If t(i) = t(k) Then Exit For
        Next k
        If k <= UBound(t) Then Exit For
    Next i

 

[Dudu2]

tu croyais vraiment que je n'allais pas la voir la 2d boucle

Mais ça c'est juste dans le Sub Test pour montrer que l'algorithme fonctionne.
Ça n'intervient aucunement dans la construction de la liste.

Dans la Function randomListNumber il n'y a bien qu'une seule boucle.

 

[Dudu2]

c'est les index qui sont dans une boucle for i non pas déplacé mais interverti

Mais quand on fait If t(i) = "" Then t(i) = i on met bien l'index directement dans le tableau, même si on intervertit après avec t(X). Et i n'est pas issu d'un tirage aléatoire.
Alors ça marche bien sûr, sans doublon surtout. Mais totalement aléatoire ?

 

[Dudu2]

1. pas besoins de contrôler les doublons => déjà expliqué, le "contrôle" du Sub Test montre que ça fonctionne, rien de plus. Ce n'est pas dans le code de construction de la liste.
2. pas besoins de contrôler si un index est déjà passé => en 100% Rnd, oui, il le faut, seulement en trouvant une méthode simple et rapide.
3. le redim preserve dès le départ me permet d’être en mini negatif => simple bug corrigé sur vbEmpty
4. c'est la garantie d'un code minimal et pérenne => Le code que je fournis n'est pas minimal et pérenne ?
5. c'est aussi la garantie de non doublons forcement => ben oui, c'est le deal de départ

 

[patricktoulon]

intervertit après avec t(X). Et i n'est pas issu d'un tirage aléatoire.

mais justement elle est là l'astuce
tu n'a aucun intérêt a boucler et choisir 2 item aléatoirement c'est même dangereux dans le sens ou tu risque de passer sur un déjà passé
pourquoi voudrais tu que je tire I aléatoirement c'est quoi l'intérêt puisque il va avoir une valeur différente immédiatement
et le if(ti)="" ou ift(x)="" c'est pour eviter les doublons justement
et le tout réellement dans une seule boucle
je fait une video explicative je reviens

 

[Dudu2]

Nan, laisse tomber la vidéo.
Je vais m'arrêter là sur le sujet

Pour info j'ai testé les temps d'exécution des 2 méthodes.
C'est quasi-identique. La méthode 100% aléatoire met 1 ou 2 centièmes de seconde de plus sur 1.000.000 d'items. Des peaux de cacahuètes hachées menu

 

[patricktoulon]

a ben a ce niveau c'est sur c'est du pipi de chat
par contre essaie sur un max de 5000 par exemple là tu va voir la différence
trop tard la vidéo est faite

 

[patricktoulon]

en tout cas merci à tous vous m'avez permis de perfectionner ma fonction