EXTRAIRE DES NOMBRES ALÉATOIRES SANS DOUBLONS

Signaler
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
-
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
-
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

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
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
69
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
Afficher les 7 commentaires