Discussion :

[Linaa]

Bonjour,

J'ai un nombre NB compris entre 0 et 10 que je veux générer aléatoirement.
Mais pas tout à fait...

J'ai fait un Randomize au chargement de mon formulaire, puis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NB = CInt(Int((10 * Rnd())))

Cela me génère pour 10 tirages

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
3
10
7
9
7
6
5
0
0
0

Mais ce que je voudrais c'est qu'à la fin du 10è tirage,
Tous les chiffres ont été tiré, parce que là j'ai plusieurs chiffres qui se répètent à la suite (0) et des chiffres qui reviennent (7)...

Merci d'avance.

[Amri_Daly]

salut
tu peut déclarer un tableau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dim tbl(0 to 9)as integer

ensuite une fonction qui cherche si un nombre existe dans la tableau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
private function Exists(nbr as integer)as boolean
dim i as integer
for i=0 to 9
if tbl(i)=nbr then
Exists=true
exit function
end if
next i
end function

et maintenant tu ajoute dans ton code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
dim i as integer
tbl(0)=CInt(Int((10 * Rnd())))   'le premier nombre aléatoire
i=1
while i<10
NB = CInt(Int((10 * Rnd())))
if not exists(nb) then 
   tbl(i)=nb
    i=i+1
end if
wend

[DarkVader]

Avec quelques lignes de moins %)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
   Dim NB As Integer, ret(0 To 9), k As Integer
    Randomize
 
    Do
        NB = CInt(Int((10 * Rnd())))
        If InStr(1, Join(ret, ","), CStr(NB)) = 0 Then ret(k) = NB: k = k + 1
    Loop Until k = 10

[zazaraignée]

Salut

J'ai fait un petit test sur une form avec un bouton et une liste:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub Command1_Click()
    Dim tabl(0 To 9) As Integer
    Dim i As Integer
    Randomize
    For i = 0 To 9
        Do
            tabl(i) = Rnd() * 10
        Loop Until EstUnique(tabl(i), i, tabl)
        List1.AddItem (tabl(i))
    Next i
End Sub
 
Private Function EstUnique(element As Variant, _
                           indice As Integer, _
                           tableau As Variant) As Boolean
    Dim i As Integer, b As Boolean
    i = 0
    b = False
    If indice > LBound(tableau) Then
        Do
            If element = tableau(i) Then b = True
            i = i + 1
        Loop Until (b) Or (i = indice)
    End If
    EstUnique = Not b
End Function

Je crois que tu peux utiliser la fonction EstUnique telle quelle. Le seul ennui est qu'elle s'avérera trop lente pour les tableaux contenant un grand nombre d'éléments.

[Linaa]

En gros, le principe de ces boucles, c'est générer un autre nombre aléatoire tant que celui-ci ne soit pas deja tiré
Mais pour un nombre elevé, elle va durer la boucle ?

De plus, le nombre que je génère, dépend du nombre d'élement d'une liste !
Donc où est-ce que je dois déclarer mon tableau et comment ?

Merci.

[DarkVader]

Il existe une solution plus simple et plus générale puisque qu'on peut choisir la liste du tirage
et qui consiste à éliminer l'élément tiré de la liste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
    Dim tmp As String, a As Integer, b As String
 
    tmp = "0123456789": a = Len(tmp)
    ReDim ret(0 To a - 1)
 
    Randomize
 
    Do
        NB = CInt(Int(((a - k) * Rnd()))): b = Mid(tmp, NB + 1, 1)
        ret(k) = b: k = k + 1: tmp = Replace(tmp, b, "")
    Loop Until k = 10

[zazaraignée]

Exact!

[Linaa]

Merci pour vos réponses !

Mais si le nombre aléatoire que je veux obtenir dépasse 9.
Sur 2 chiffres donc, cela ne va pas fonctionner.

[SfJ5Rpw8]

tiens une autre maniére ( sous le même principe quand même), en utilisant un tableau de booleen pour mémoriser les numéros déjà sortis...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub MonAlea()
 Dim iMax As Integer
 Dim bMemo() As Boolean
 Dim Nb As Integer
 Dim k As Integer
 iMax = 10
 iMin = 0
 ReDim bMemo(iMin To iMax)
 Randomize
 While k <= (iMax - iMin)
    Nb = Int((iMax - iMin + 1) * Rnd + iMin)
 
    If Not bMemo(Nb) Then
      bMemo(Nb) = True
      Debug.Print Nb 'Tirage... 'Rajouter ici le traitement à effectuer sur tirage...
      k = k + 1
 
    End If
    DoEvents
  Wend
End Sub

[DarkVader]

Merci pour vos réponses !

Mais si le nombre aléatoire que je veux obtenir dépasse 9.
Sur 2 chiffres donc, cela ne va pas fonctionner.

Il n'est pourtant pas très difficile à adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
    Dim NB As Integer, ret(), k As Integer
    Dim tmp As String, a As Integer, b As String
 
    tmp = "AA,AB,ACK,BC,CB,GH,HIO,JK,LM,MO,": a = UBound(Split(tmp, ","))
    ReDim ret(0 To a - 1)
 
    Randomize
 
    Do
        NB = CInt(Int(((a - k) * Rnd()))): b = Split(tmp, ",")(NB)
        ret(k) = b: k = k + 1: tmp = Replace(tmp, "," & b & ",", ",")
    Loop Until k = a

[SfJ5Rpw8]

tiens encore une autre maniére ... ce coup-ci on remplit un tableau avec les numéros à sortir... puis à chaque tirage on "enléve" le numéro du tableau ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
'
' Fonction efface element d'un tableau...
'
Function EffaceElement(lIndex As Long, t()) As Boolean
Dim i As Long
If lIndex > UBound(t) Then
  Debug.Print "Erreur index trop grand"
  EffaceElement = False
  Exit Function
End If
If lIndex < LBound(t) Then
  Debug.Print "Erreur index trop petit"
  EffaceElement = False
  Exit Function
End If
For i = lIndex To UBound(t) - 1
  t(i) = t(i + 1)
 
Next
ReDim Preserve t(UBound(t) - 1)
EffaceElement = True
 
End Function
 
'
' Tirage aleatoire...
'
Sub MonAlea()
 Dim iMax As Integer
 Dim iMin As Integer
 
 Dim iTmax As Integer
 
 Dim bMemo() As Variant
 Dim Nb As Long
 Dim k As Integer
 iMax = 10
 iMin = 0
 ReDim bMemo(iMin To iMax)
 
 For k = iMin To iMax
   bMemo(k) = k
 Next
 
 Randomize
 iTmax = UBound(bMemo)
 While iTmax >= 0
 
    Nb = Int((UBound(bMemo) + 1) * Rnd + iMin)
     Debug.Print bMemo(Nb)
     If UBound(bMemo) > 0 Then
         EffaceElement Nb, bMemo
           iTmax = UBound(bMemo)
       Else
        iTmax = -1
       End If
      DoEvents
     Wend
End Sub

[DarkVader]

C'est quoi le but - Trouver la solution la plus longue ou la plus tordue ?

[SfJ5Rpw8]

C'est quoi le but - Trouver la solution la plus longue ou la plus tordue ?

ben je sais pas j'ai du choisir la solution la plus longue et toi la plus tordue :





sinon il faudrai revoir ton code pour le cas ou la fonction aleatoire renvoi NB =0 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
...
    tmp = "AA,AB,ACK,BC,CB,GH,HIO,JK,LM,MO,": a = UBound(Split(tmp, ","))
   ...
 tmp = Replace(tmp, "," & b & ",", ",")
..

[Linaa]

sinon il faudrai revoir ton code pour le cas ou la fonction aleatoire renvoi NB =0 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
...
    tmp = "AA,AB,ACK,BC,CB,GH,HIO,JK,LM,MO,": a = UBound(Split(tmp, ","))
   ...
 tmp = Replace(tmp, "," & b & ",", ",")
..

En effet, si nb vaut 0, le split ne fera rien
Pour la soustraire, il faudrait faire un b = Mid(tmp, 1, 2)
Ensuitre re-tester nb pour faire le replace tmp = Replace(tmp, b & ",", "")

Sinon je vais opter pour la solution avec le tableau de booleen qui est la plus simple à mon avis !

Merci à tous !

[DarkVader]

.../...
sinon il faudrai revoir ton code pour le cas ou la fonction aleatoire renvoi NB =0 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
...
    tmp = "AA,AB,ACK,BC,CB,GH,HIO,JK,LM,MO,": a = UBound(Split(tmp, ","))
   ...
 tmp = Replace(tmp, "," & b & ",", ",")
..

Exact, j'ai répondu un peu vite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
    Dim NB As Integer, ret(), k As Integer
    Dim tmp As String, a As Integer, b As String
 
    tmp = "AA,AB,ACK,BC,CB,GH,HIO,JK,LM,MO,GHJ,KLM,": a = UBound(Split(tmp, ","))
    ReDim ret(0 To a - 1)
 
    Randomize
 
    Do
        NB = CInt(Int(((a - k) * Rnd()))): b = Split(tmp, ",")(NB): ret(k) = b
        k = k + 1:  tmp = Replace(tmp, IIf(NB <> 0, ",", "") & b & ",", IIf(NB <> 0, ",", ""))
    Loop Until k = a