EXTRAIRE DES NOMBRES ALÉATOIRES SANS DOUBLONS
jmfmarques
Messages postés
7666
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
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
https://codes-sources.commentcamarche.net/source/40774-extraire-des-nombres-aleatoires-sans-doublons
2 déc. 2009 à 15:00
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
29 mars 2007 à 11:29
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)
29 mars 2007 à 11:16
je suis debutant et j ai essayé il me met erreur 424
peut tu m expliquer
merci d avance
19 déc. 2006 à 14:28
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
19 déc. 2006 à 08:33
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.
18 déc. 2006 à 23:17
Clair que les moyens sont différents mais la finalité me semble la même.
18 déc. 2006 à 22:00
J'ai oublié d'enlever la ligne :
a = a & vbCrLf & tabl(ou)
que j'utilisais pour un affichage différent et n'a plus d'utilité ici. SUPPRIMEZ-LA...