EXTRAIRE DES NOMBRES ALÉATOIRES SANS DOUBLONS

jmfmarques
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
- 18 déc. 2006 à 22:00
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
- 2 déc. 2009 à 15:00
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/40774-extraire-des-nombres-aleatoires-sans-doublons

Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
71
2 déc. 2009 à 15:00
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
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
71
29 mars 2007 à 11:29
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)
jcharles78
Messages postés
3
Date d'inscription
mardi 21 août 2012
Statut
Membre
Dernière intervention
29 mars 2007

29 mars 2007 à 11:16
Bonjour

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

19 déc. 2006 à 14:28
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
jmfmarques
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
19 déc. 2006 à 08:33
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