Fonction pour créer une série de chiffre aléatoire dans une plage donnée, sans doublon, récupération dans un tableau.
J’ai cherché, mais pas trouvé le code convenant à mon besoin.
Ayant passé trop de temps dessus, si cela peu servire ….
Sur un Form
3 Labels, Label1(0,1 et 2)
2 TextBoxs, Text1(0 et 1)
2 ListBoxs, list1 et List2, List1.Sorted = True, List2.Sorted = False
1 Commandbutton, Command1
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Type PointPixels
 Col As Long
 Lig As Long
 Coul As Long
End Type
Dim Tbl_ColLig() As PointPixels
Dim Debut As Long, Fin As Long
Dim MinI As Long, MaxI As Long
Dim ChifrAleatoire As String
 
 
Private Sub Form_Load()
'placements des différents contrôles
Label1(2).Move 0, 60, 1710, 195: Label1(2).Caption = "Plage du tirage aleatoire"
Label1(1).Move 2070, 390, 210, 195: Label1(1).Caption = "Fin"
Label1(0).Move 1890, 60, 435, 195: Label1(0).Caption = "Debut"
Text1(0).Move 2460, 0, 735, 285: Text1(0).Text = "7"
Text1(1).Move 2460, 360, 735, 285: Text1(1).Text = "27"
List1.Move 60, 750, 1785, 6105: List1.Clear
List2.Move 1920, 750, 1785, 6105: List2.Clear
Command1.Move 60, 420, 1335, 255: Label1(1).Caption = "Go"
End Sub
 
Private Sub Command1_Click()
Dim TiragCol() As Long
Dim TiragLig() As Long
Me.Caption = "en cours ....... "
Debut = GetTickCount()
'1° tirage
TiragCol = TirageAleatoire(CLng(Text1(0).Text), CLng(Text1(1).Text))
'2° tirage
TiragLig = TirageAleatoire(CLng(Text1(0).Text), CLng(Text1(1).Text))
ReDim Tbl_ColLig(0 To CLng(Text1(1).Text) - CLng(Text1(0).Text))
 
Fin = GetTickCount()
Me.Caption = (UBound(TiragCol) + 1) & "  /  " & Fin - Debut & " mSc "
List1.Clear: List2.Clear
Fin = 0
For Debut = LBound(TiragCol) To UBound(TiragCol)
 List1.AddItem TiragCol(Fin)
 List2.AddItem TiragCol(Fin)
 Tbl_ColLig(Fin).Col = TiragCol(Fin)
 Tbl_ColLig(Fin).Lig = TiragLig(Fin)
 Tbl_ColLig(Fin).Coul = 0
 Fin = Fin + 1
Next Debut
 
End Sub
 
'*************************************************************************************
'************************** la partie utile ******************************************
'*************************************************************************************
Public Function TirageAleatoire(ByVal DebPlage As Long, ByVal FinPlage As Long)
Dim T As Long, U As Long, FinBoucle As Long
Dim Tbl_Temp() As Long
'pour gagner un peu de temps, évite à la boucle Do ...Loop le calcul de sortie a chaque fois
FinBoucle = FinPlage - DebPlage
Randomize 'Initialise le générateur de nombres aléatoires
'pour situer les bornes pour le tirage aléatoire
MinI = DebPlage: MaxI = FinPlage
ReDim Tbl_Temp(0 To MaxI - MinI)
ChifrAleatoire = "|"
 
T = 0
Do
 U = Int((MaxI - MinI + 1) * Rnd + MinI) 'tirage pseudo aléatoire
 'recherche si le nouveau chiffre n'est pas déjà tiré
 If InStr(ChifrAleatoire, "|" & CStr(U) & "|") = 0 Then
  Tbl_Temp(T) = U 'remplis le tableau temporaire
  T = T + 1
  ChifrAleatoire = ChifrAleatoire & U & "|" 'actualise la chaine servant à la comparaison
  'pour réduire la plage de tirage aléatoire aux chiffres non encor tirés
  'ici il faut supprimer, dans la chaîne ChifrAleatoire,
  'le chiffre correspondant soit à  U = MinI, soit à U = MaxI
  'puisque ce chiffre ne sera plus tiré
  If U = MinI Or U = MaxI Then
   If U = MinI Then MinI = NewBorne("Mini") Else MaxI = NewBorne("Maxi")
  End If
 End If
 DoEvents
Loop Until T > FinBoucle
'passe le tableau dans le nom de la fonction
TirageAleatoire = Tbl_Temp
End Function
 
Public Function NewBorne(MiniMaxi As String) As Long
Dim PosDeb As Long, PosFin As Long
Dim Chaine As String
PosDeb = -1
If MiniMaxi = "Mini" Then
 NewBorne = MinI
 Do
  PosDeb = InStr(ChifrAleatoire, "|" & CStr(NewBorne) & "|")
  If PosDeb <> 0 Then
   'supprime ce chiffre de la chaine de comparaison
   'recupération de la partie gauche
   Chaine = Left(ChifrAleatoire, PosDeb - 1)
   PosFin = PosDeb + Len(CStr(NewBorne))
   'recomposition avec recupération de la partie droite
   Chaine = Chaine & Right(ChifrAleatoire, Len(ChifrAleatoire) - PosFin)
   'actualise la chaine de comparaison
   ChifrAleatoire = Chaine
   'incrémante la borne basse
   NewBorne = NewBorne + 1
   Else
   Exit Do
  End If
  DoEvents
 Loop Until PosDeb = 0
 Else
 NewBorne = MaxI
 Do
  PosDeb = InStr(ChifrAleatoire, "|" & CStr(NewBorne) & "|")
  If PosDeb <> 0 Then
   'supprime ce chiffre de la chaine de comparaison
   'recupération de la partie gauche
   Chaine = Left(ChifrAleatoire, PosDeb - 1)
   PosFin = PosDeb + Len(CStr(NewBorne))
   'recomposition avec recupération de la partie droite
   Chaine = Chaine & Right(ChifrAleatoire, Len(ChifrAleatoire) - PosFin)
   'actualise la chaine de comparaison
   ChifrAleatoire = Chaine
   'decrémante la borne haute
   NewBorne = NewBorne - 1
   Else
   Exit Do
  End If
  DoEvents
 Loop Until PosDeb = 0
End If
End Function
'*************************************************************************************
'********************** fin la partie utile ******************************************
'*************************************************************************************
Je reste ouvert à toutes propositions qui amélioreraient la rapidité, pour mon besoin, la vitesse du code étant essentielle.