Extraire des nombres aléatoires sans doublons

Soyez le premier à donner votre avis sur cette source.

Snippet vu 10 590 fois - Téléchargée 25 fois

Contenu du snippet

Bon, c'est un truc à quatre sous espagnols, mais l'ouverture d'un récent sujet me donne à penser qu'il convient de déposer ce petit code.

Il permet d'extraire à très vive allure, dans doublons, des nombres aléatoires d'une fourchette de nombres.

La technique utilisée est très différente des techniques habituelles. Je ne vais jamais rechercher si un nombre a déjà été utilisé. J'app)lique tout simplement une technique du "pousse-toi de là que je m'y mette", largement inspirée des habitudes bien connues d'un sapeur pompier (il s'appelait Camembert.... je ne plaisante pas...) auquel son chef avait fait remarquer qu'il y avait un trou dans la cour de la caserne. Notre brave ami Camembert a bouché ce trou en creusant un peu plus loin pour récolter de la terre et boucher le 1er trou. Mais voilà ! le 1er était bouché, mais il y en avait alors un autre, ainsi créé... qu'il a bouché en faisant donc un 3ème trou... et ainsi de suite .....à l'infini !!!!

Attitude idiote ? Certes !... Mais je m'en suis servi souvent (je vous raconterai un jour comment on peut l'utiliser pour avoir 1.000.000 d'idarts apparemment identiques dans une base de données et les retrouver tous à la vitesse grand V..., aussi rapidement que si l'on connaissait chacun des idarts concernés... dur dur et à la fois facile facile... merci à cet innocent de sapeur Camembert...)

Amitiés d'un vieux fou.

Source / Exemple :


Non !
Pas de zip pour si peu :

Une form, une listbox nommée List1 et un bouton de commande nommé Command1.

Code :

Private Sub Command1_Click()
  Const nbmini = 100 '-----ici la borne inférieure
  Const nbmaxi = 200 '-----ici la borne supérieure
  Const nbatirer = 101  'ici le nombre de numéros aléatoires à sortir entre les 2 bornes
  fourch = nbmaxi - nbmini
  If fourch + 1 < nbatirer Then
    MsgBox "Il est impossible de tirer " & nbatirer & "nombres dans la fourchette comprise entre " _
    & nbmini & " et " & nbmaxi & " qui ne comprend que " & fourch + 1 & " nombres, VOYONS !!!"
    Exit Sub
  End If
  Randomize
  Dim tabl(nbmaxi - nbmini + 1) As Integer, i As Integer, a As String, ou As Integer
  For i = 0 To nbmaxi - nbmini
    tabl(i) = nbmini + i
  Next
  List1.Clear
  For i = 0 To nbatirer - 1
    ou = Int(((fourch - i) * Rnd))
    a = a & vbCrLf & tabl(ou)
    List1.AddItem tabl(ou)
    tabl(ou) = tabl(fourch - i)
  Next
  Erase tabl
End Sub

Voilà tout ! Vous aurez l'occasion de mesurer la vitesse de traitement !

Je signe ici mais aurait préféré y voir celle de notre ami sapeurpompier, décédé il y a des décennies....

A voir également

Ajouter un commentaire

Commentaires

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
autre version,

plus facilement réutilisable,

peut etre...

Private mxbAvailable() As Boolean
Private mnAvailable As Long

Private Sub Reset(ByVal vnMin As Long, ByVal vnMax As Long)
Dim nIndex As Long
Randomize
ReDim mxbAvailable(vnMin To vnMax)
mnAvailable = 0
For nIndex = LBound(mxbAvailable) To UBound(mxbAvailable)
mxbAvailable(nIndex) = True
mnAvailable = mnAvailable + 1
Next
End Sub

Private Function GetNext(ByVal vnMin As Long, ByVal vnMax As Long) As Long
Dim nIndex As Long
If mnAvailable Then
Do
nIndex = Rnd * vnMax
If nIndex >= vnMin And nIndex <= vnMax Then
If mxbAvailable(nIndex) Then
Exit Do
End If
End If
Loop
mxbAvailable(nIndex) = False
mnAvailable = mnAvailable - 1
GetNext = nIndex
End If
End Function

Private Sub Form_Load()
Reset 9, 32
Do While mnAvailable
Debug.Print GetNext(9, 32)
Loop
End Sub
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
diablamanshadow>

For i = nbatirer - 1 To 0 Step -1
For j = LstBan.ListCount To 0 Step -1
If LstGenere.List(i) = LstBan.List(j) Then
LstGenere.RemoveItem (i)
End If
Next
Next

pas top ces deux boucles imbriquées...
plutot que de supprimer tes items, mieux vaux ne pas les y ajouter ^^

jcharles78>
avec quel code ? celui de jmfmarques ?
si oui, as tu bien ajouté un ListBox et un bouton de commande, comme attendu ? (sans les renommer)
Messages postés
3
Date d'inscription
mardi 21 août 2012
Statut
Membre
Dernière intervention
29 mars 2007

Bonjour

je suis debutant et j ai essayé il me met erreur 424
peut tu m expliquer
merci d avance
Messages postés
419
Date d'inscription
lundi 30 août 2004
Statut
Membre
Dernière intervention
28 janvier 2008

en faite il a mis cette source suite a mon poste d'aide pour un rnd il m'avais donner son code mais helas il ne convenais pas a 100% a ce que je voulais moi je voulais un code comme le siens qui genere entre une fourchette et une autre x chiffre (ca ses se qu'il a fait) mais je voulais egalement avoir une list de chiffre "banni" les chiffre de la colonne generee une fois deplacer dans la liste des "banni" ne pourrons plus etre tirer et inversement on peut debannir un chiffre vla le code :

Private Sub CmdAdd_Click()
LstGenere.AddItem LstBan.List(LstBan.ListIndex)
LstBan.RemoveItem (LstBan.ListIndex)
End Sub

Private Sub CmdGenere_Click()
Const nbmini = 1 '-----ici la borne inférieure
Const nbmaxi = 10 '-----ici la borne supérieure
Const nbatirer = 10 'ici le nombre de numéros aléatoires à sortir entre les 2 bornes

fourch = nbmaxi - nbmini

If fourch + 1 < nbatirer Then
MsgBox "Il est impossible de tirer " & nbatirer & "nombres dans la fourchette comprise entre " _
& nbmini & " et " & nbmaxi & " qui ne comprend que " & fourch + 1 & " nombres, VOYONS !!!"
Exit Sub
End If

Randomize

Dim tabl(nbmaxi - nbmini + 1) As Integer, i As Integer, a As String, ou As Integer

For i = 0 To nbmaxi - nbmini
tabl(i) = nbmini + i
Next

LstGenere.Clear

For i = 0 To nbatirer - 1
ou = Int(((fourch - i) * Rnd))
a = a & vbCrLf & tabl(ou)
LstGenere.AddItem tabl(ou) ' <<<<<<<<<<============pour ajouter à la listbox LstGenere
tabl(ou) = tabl(fourch - i)
Next

For i = nbatirer - 1 To 0 Step -1
For j = LstBan.ListCount To 0 Step -1
If LstGenere.List(i) = LstBan.List(j) Then
LstGenere.RemoveItem (i)
End If
Next
Next

Erase tabl '<<<<<<<<<<===== on en profite pour libérér la mémoire
LblNbG.Caption = LstGenere.ListCount
LblNbB.Caption = LstBan.ListCount
End Sub

Private Sub CmdSupp_Click()
LstBan.AddItem LstGenere.List(LstGenere.ListIndex)
LstGenere.RemoveItem (LstGenere.ListIndex)
End Sub

comme vous le voyez j'ai ajouter un bouton cmdsupp (pour ajouter a la liste des ban) et un chiffre add (pour debannir) j'ai egalement ajouter quelques lignes entre
tabl(ou) = tabl(fourch - i)
et
erase tabl

c'est ses quelques lignes qui permette de virer les chiffre qui sont "ban" de la liste generer ^^

Bien a vous
Diablaman

Bien evidement je note la source a 8 vu qu'elle ma tres bien servie mais qu'il me manquais un ptit truc ^^
Next
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
23
Bonjour BruNews;

la finalité ne "semble" pas la même : elle l'est et je l'ai dit ("La technique utilisée est très différente des techniques habituelles").

Je n'ai voulu déposer ce code que pour cette raison : simplicité et très grande rapidité du fait que je ne vais jamais rechercher si un nombre a déjà été tiré. L'ayant déplacé dés son tirage, il est automatiquement ignoré et je n'ai pas non plus besoin de redimensionner un tableau après une suppression (que je ne fais pas).

Il est certain que l'on pourrait inventer d'autres méthodes encore (je l'ai fait). Celle-ci est toutefois la plus rapide, surtout sur des nombres élévés. Voilà pourquoi cette méthode est exposée ici.
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.