Discussion :

[ProgElecT]

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.

[OhMonBato]

Alors sauf erreur de ma part, je pense avoir trouvé beaucoup plus court avec ce système. En faisant un test pour une liste de 1 à 10000 je mets environ 39s avec ton code et environ 130ms avec celui ci :

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
 
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim MinI As Long, MaxI As Long
Dim Debut As Long, Fin As Long
Dim TableauInitial() As Long
Dim TableauFinal() As Long
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 = "1"
Text1(1).Move 2460, 360, 735, 285: Text1(1).Text = "10000"
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 i As Long
Dim Ch As String
Dim Nb      'Variant pour splitter la chaine contenant les nombres à choisir
Dim NbAleatoire  'Indice aléatoire pour choisir un élément de la chaine contenant les nombres
Me.Caption = "en cours ....... "
Debut = GetTickCount()
MinI = Val(Text1(0))
MaxI = Val(Text1(1))
ReDim TableauInitial(MaxI - MinI)
ReDim TableauFinal(MaxI - MinI)
'On va générer une chaine partant du premier au dernier chiffre (donc de 1 à 10000 par défaut), les chiffres étant séparés par une virgule
'Par défaut on aura donc Ch = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,...,9999,10000"
Ch = MinI
For i = MinI + 1 To MaxI
  Ch = Ch & "," & i
  TableauInitial(i - MinI) = i
Next i
'On met les chiffres dans un tableau issu du split de la chaine contenant tous les nombres
'On tire un nombre x parmi les n éléments
'Si ce nombre n'est pas le dernier de la liste, le nombre d'indice x devient le nombre d'indice n
'Par exemple au premier tirage on tire le 7ème nombre parmi les 10000, donc 7 pour mon exemple
'Dans le tableau Nb, on remplace 7 par 10000
'Puis on tire un nombre x parmi les n - 1 éléments (donc parmi les 9999 de mon tableau Nb), ça ne peut pas être 7 puisqu'il a été remplacé par le 10000ème
'Si ce nombre n'est pas le n - 1  de la liste, le nombre d'indice x devient le nombre d'indice n - 1
'Etc...
Nb = Split(Ch, ",")
Randomize 'Initialise le générateur de nombres aléatoires
For i = MaxI - MinI To 0 Step -1
  NbAleatoire = Int((i + 1) * Rnd)
  TableauFinal(MaxI - MinI - i) = Nb(NbAleatoire)
  If NbAleatoire < i Then Nb(NbAleatoire) = Nb(i)
Next i
Fin = GetTickCount()
Me.Caption = MinI & " à " & MaxI & "  /  " & Fin - Debut & " mSc "
List1.Clear: List2.Clear
For i = MinI To MaxI
  List1.AddItem i
  List2.AddItem TableauFinal(i - MinI)
Next i
End Sub

pour info la listbox1 a sa propriété Sorted mise à False également pour le reste j'ai utilisé les mêmes composants que toi.

J'ai essayé de commenter mais si ce n'est pas clair, ne pas hésiter à me demander

[ProgElecT]

Merci OhMonBato et

Je sentais bien que ma solution était loin d’être la meilleure, mais un peu provocateur, je l’ai quand même soumis ici, dans l’espoir qu’une personne généreuse et largement plus compétente que moi dans ce domaine, proposerait une solution beaucoup plus performante.

J’ai pourtant recherché des réponses, en particulier dans le forum Algo de DVP, mais quand l’on n’est pas un matheux, on ne trouve sûrement pas les bons mots à mettre dans la requête de recherche.

J’adopte ta solution énormément plus rapide, car je dois pouvoir récupérer, dans le pire des cas, 768 séries de 1024 chiffres aléatoires, tu comprendras que le code que tu proposes m’intéresse grandement.

Encor un grand merci.

Motif de l'edit:
Ne gênant nullement à la belle solution de OhMonBato.
A la fin du Form_Load

Code :

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

1
2
3
Command1.Move 60, 420, 1335, 255: Command1.Caption = "Go"
Me.Height = List1.Top + List1.Height + 420
Me.Width = List2.Left + List2.Width + (List1.Left * 3)

TableauInitial() ne servant pas, il peut être supprimé partout ou il apparaît

[DarkVader]

Si je puis me permettre, les opérations sur les strings n'étant pas des plus optimisées

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
Private Sub Command1_Click()
    Dim i As Long
    Dim Ch As String
'    Dim Nb      'Variant pour splitter la chaine contenant les nombres à choisir
    Dim Nb() As Long 'Tableau ... pour splitter la chaine contenant les nombres à choisir
    Dim NbAleatoire  'Indice aléatoire pour choisir un élément de la chaine contenant les nombres
 
    Me.Caption = "en cours ....... "
    Debut = GetTickCount()
    MinI = Val(Text1(0))
    MaxI = Val(Text1(1))
    ReDim TableauInitial(MaxI - MinI)
    ReDim TableauFinal(MaxI - MinI)
    ReDim Nb(0 To MaxI - MinI)
    'On va générer une chaine partant du premier au dernier chiffre (donc de 1 à 10000 par défaut), les chiffres étant séparés par une virgule
    'Par défaut on aura donc Ch = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,...,9999,10000"
    Ch = MinI
    Nb(0) = MinI
    For i = MinI + 1 To MaxI
      'Ch = Ch & "," & i
      Nb(i - MinI) = i
      TableauInitial(i - MinI) = i
    Next i
 
    'On met les chiffres dans un tableau issu du split de la chaine contenant tous les nombres
    'On tire un nombre x parmi les n éléments
    'Si ce nombre n'est pas le dernier de la liste, le nombre d'indice x devient le nombre d'indice n
    'Par exemple au premier tirage on tire le 7ème nombre parmi les 10000, donc 7 pour mon exemple
    'Dans le tableau Nb, on remplace 7 par 10000
    'Puis on tire un nombre x parmi les n - 1 éléments (donc parmi les 9999 de mon tableau Nb), ça ne peut pas être 7 puisqu'il a été remplacé par le 10000ème
    'Si ce nombre n'est pas le n - 1  de la liste, le nombre d'indice x devient le nombre d'indice n - 1
    'Etc...
 
    'Nb = Split(Ch, ",")
 
    Randomize 'Initialise le générateur de nombres aléatoires
    For i = MaxI - MinI To 0 Step -1
      NbAleatoire = Int((i + 1) * Rnd)
      TableauFinal(MaxI - MinI - i) = Nb(NbAleatoire)
      If NbAleatoire < i Then Nb(NbAleatoire) = Nb(i)
    Next i
    Fin = GetTickCount()
    Me.Caption = MinI & " à " & MaxI & "  /  " & Fin - Debut & " mSc "
    List1.Clear: List2.Clear
    For i = MinI To MaxI
      List1.AddItem i
      List2.AddItem TableauFinal(i - MinI)
    Next i
End Sub

[OhMonBato]

Oui effectivement, j'étais parti d'abord sur une autre idée avec traitement uniquement sur chaine de caractère et quand j'ai pensé à cette méthode, je ne sais pas pourquoi j'ai gardé ma chaine de départ... , je passe alors effectivement de 120/130ms à 15ms environ en n'utilisant plus les chaines pour une série de 1 à 10000, encore un gain intéressant.