transcription d'un pascal en vba
bonjour
je reprends la discussion de oscar.cesar sur son code pascal en vers du vba.
je rappelle le code initial:
Code:
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
|
program Reducteur;
{$APPTYPE CONSOLE}
uses
SysUtils;
{
Objectif : programme de calcul de systèmes réducteurs
Le programme calcule le nombre de combinaisons nécessaires pour
être sûr d'obtenir n numéros parmis m tirés sur une sélection de p numéros
}
type
TCombinaison = record
Necessaire : Boolean;
Tirage : array[0..5] of byte; ‘taille de la combinaison
end;
function Combinaison(AValeurMax : Integer; ASelection : Integer) : Integer;
var
i : Integer;
p : Integer;
r : Int64;
begin
r := 1;
p := AValeurMax;
for i := 0 to Pred(ASelection) do begin
r := p * r;
Dec(p);
end;
p := ASelection;
for i := 0 to Pred(ASelection) do begin
r := r div p;
Dec(p);
end;
Result := r;
end;
var
i : integer;
j,k,l : Integer;
nb_numeros_tires : Integer;
nb_numeros_selectionnes : Integer;
nb_numeros_objectif : Integer;
nb_numeros_max : Integer;
combinaisons : array of TCombinaison;
nb_combinaisons : Integer;
nb_numero_communs : Integer;
nb_combinaisons_selectionnee : Integer;
begin
nb_numeros_tires := 6; // on part de cette base pour le loto
nb_numeros_max := 49;
nb_numeros_objectif := 3;
for nb_numeros_selectionnes := nb_numeros_tires to nb_numeros_max do begin
// calcul du nombre de combinaisons possibles
nb_combinaisons := Combinaison(nb_numeros_selectionnes, nb_numeros_tires);
SetLength(combinaisons, nb_combinaisons);
System.Writeln(Format('Selection : %d '#7' Combinaisons : %d', [nb_numeros_selectionnes, nb_combinaisons]));
// remplissage du tableau ‘faire une variable pour tableau de taille 3 à 10 max
combinaisons[0].Tirage[0] := 1;
combinaisons[0].Tirage[1] := 2;
combinaisons[0].Tirage[2] := 3;
combinaisons[0].Tirage[3] := 4;
combinaisons[0].Tirage[4] := 5;
combinaisons[0].Tirage[5] := 6;
Combinaisons[0].Necessaire := True; // Par défaut on garde tout
if High(Combinaisons) > 0 then begin
for i := 1 to High(Combinaisons) do begin
for j := 0 to High(Combinaisons[i].Tirage) do begin
Combinaisons[i].Tirage[j] := Combinaisons[i-1].Tirage[j];
end;
j := High(Combinaisons[i].Tirage);
Inc(Combinaisons[i].Tirage[j]);
while Combinaisons[i].Tirage[j] > (nb_numeros_selectionnes + j -
High(Combinaisons[i].Tirage)) do begin
Inc(Combinaisons[i].Tirage[j-1]);
Dec(j);
end;
for j := 1 to High(Combinaisons[i].Tirage) do begin
if Combinaisons[i].Tirage[j] > (nb_numeros_selectionnes + j -
High(Combinaisons[i].Tirage)) then begin
Combinaisons[i].Tirage[j] := Combinaisons[i].Tirage[j-1] + 1;
end;
end;
Combinaisons[i].Necessaire := True;
end; ‘fin bcle I
end; ‘fin du if
// Recherche des combinaisons nécessaires
nb_combinaisons_selectionnee := 0;
for i := 0 to Pred(nb_combinaisons) do begin
if Combinaisons[i].Necessaire then begin
Inc(nb_combinaisons_selectionnee);
for j := i + 1 to Pred(nb_combinaisons) do begin
nb_numero_communs := 0;
for k := 0 to High(Combinaisons[i].Tirage) do begin
for l := 0 to High(Combinaisons[j].Tirage) do begin
if Combinaisons[i].Tirage[k] = Combinaisons[j].Tirage[l] then begin
Inc(nb_numero_communs);
if nb_numero_communs = nb_numeros_objectif then break;
end;
end;
if nb_numero_communs = nb_numeros_objectif then break;
end;
if nb_numero_communs = nb_numeros_objectif then begin
Combinaisons[j].Necessaire := False;
end;
end;
end;
end;
// Affichage
Writeln(Format('%d combinaisons necessaires', [nb_combinaisons_selectionnee]));
for i := 0 to Pred(nb_combinaisons) do begin
if Combinaisons[i].Necessaire then begin
for j := 0 to High(Combinaisons[i].Tirage) do begin
write(Format('%.2d ', [Combinaisons[i].Tirage[j]]));
end;
writeln('');
end;
end;
end;
system.Readln;
end. |
j'ai essayé de recoder en vba par rapport à mes petites connaissances et avec les conseils du forum mais j'avoue que cela est pas simple
voila ou j'en suis
actuellement j'ai une erreur execution depassement de pile ?
voici le code
Code:
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
137
138
139
140
141
142
143
|
'Type TCombinaison
Dim Necessaire As Boolean
Dim AValeurMax As Integer
Dim ASelection As Integer
Dim Tirage(0 To 5) As Byte 'taille de la combinaison
'end type
Function Combinaison(AValeurMax, ASelection) As Integer
Dim i As Integer
Dim p As Integer
Dim r As Long
r = 1
p = AValeurMax
'For i = 0 To Pred(ASelection)
For i = 0 To (ASelection - 1)
r = p * r
p = p - 1
Next
p = ASelection
'For i = 0 To Pred(ASelection)
For i = 0 To (ASelection - 1)
r = r \ p
p = p - 1
Next
Result = r
'end fonction
Dim j As Integer, k As Integer, l As Integer
Dim nb_numeros_tires As Integer
Dim nb_numeros_selectionnes As Integer
Dim nb_numeros_objectif As Integer
Dim nb_numeros_max As Integer
Dim combinaisons() 'As TCombinaison
Dim nb_combinaisons As Integer
Dim nb_numero_communs As Integer
Dim nb_combinaisons_selectionnee As Integer
nb_numeros_tires = 4 ' on part de cette base pour le loto 6
nb_numeros_max = 49
nb_numeros_objectif = 3
For nb_numeros_selectionnes = nb_numeros_tires To nb_numeros_max
' calcul du nombre de combinaisons possibles
nb_combinaisons = Combinaison(nb_numeros_selectionnes, nb_numeros_tires)
ReDim combinaisons(0 To nb_combinaisons) 'SetLength(combinaisons, nb_combinaisons)
'System.Writeln(Format('Selection : %d '#7' Combinaisons : %d', (nb_numeros_selectionnes, nb_combinaisons)))
' remplissage du tableau ‘faire une variable pour tableau de taille 3 à 10 max
combinaisons(0).Tirage(0) = 1
combinaisons(0).Tirage(1) = 2
combinaisons(0).Tirage(2) = 3
combinaisons(0).Tirage(3) = 4
combinaisons(0).Tirage(4) = 5
combinaisons(0).Tirage(5) = 6
combinaisons(0).Necessaire = True ' Par défaut on garde tout
If UBound(combinaisons) > 0 Then
For i = 1 To UBound(combinaisons)
For j = 0 To UBound(combinaisons(i).Tirage)
combinaisons(i).Tirage(j) = combinaisons(i - 1).Tirage(j)
Next
j = UBound(combinaisons(i).Tirage)
combinaisons(i).Tirage(j) = combinaisons(i).Tirage(j) + 1
Do While combinaisons(i).Tirage(j) > (nb_numeros_selectionnes + j _
- UBound(combinaisons(i).Tirage))
combinaisons(i).Tirage(j - 1) = combinaisons(i).Tirage(j - 1) + 1
j = j - 1
Loop
For j = 1 To UBound(combinaisons(i).Tirage)
If combinaisons(i).Tirage(j) > (nb_numeros_selectionnes + j _
- UBound(combinaisons(i).Tirage)) Then
combinaisons(i).Tirage(j) = combinaisons(i).Tirage(j - 1) + 1
End If
Next
combinaisons(i).Necessaire = True
Next
End If
' Recherche des combinaisons nécessaires
nb_combinaisons_selectionnee = 0
For i = 0 To (nb_combinaisons - 1)
If combinaisons(i).Necessaire Then
nb_combinaisons_selectionnee = nb_combinaisons_selectionnee + 1
For j = i + 1 To (nb_combinaisons - 1)
nb_numero_communs = 0
For k = 0 To UBound(combinaisons(i).Tirage)
For l = 0 To UBound(combinaisons(j).Tirage)
If combinaisons(i).Tirage(k) = combinaisons(j).Tirage(l) Then
nb_numero_communs = nb_numero_communs + 1
If nb_numero_communs = nb_numeros_objectif Then Exit For
End If
Next
If nb_numero_communs = nb_numeros_objectif Then Exit For
Next
If nb_numero_communs = nb_numeros_objectif Then
combinaisons(j).Necessaire = False
End If
Next
End If
Next
' Affichage
'Writeln(Format('%d combinaisons necessaires', (nb_combinaisons_selectionnee)))
For i = 0 To (nb_combinaisons - 1)
If combinaisons(i).Necessaire Then
For j = 0 To UBound(combinaisons(i).Tirage)
'write(Format('%.2d ', (Combinaisons(i).Tirage(j))))
Next
'writeln('')
End If
Next
Next
'End Sub
End Function
Private Sub CommandButton1_Click()
Call Combinaison(AValeurMax, ASelection)
End Sub |
merci pour le coup de main .;)
