Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 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és17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 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és3Date d'inscriptionmardi 21 août 2012StatutMembreDernière intervention29 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és419Date d'inscriptionlundi 30 août 2004StatutMembreDernière intervention28 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és7666Date d'inscriptionsamedi 5 novembre 2005StatutMembreDernière intervention22 août 201427 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.
BruNews
Messages postés21040Date d'inscriptionjeudi 23 janvier 2003StatutModérateurDernière intervention21 août 2019 18 déc. 2006 à 23:17
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...