Discussion :

[didier.schmit]

bonjour
je reprends la discussion de oscar.cesar sur son code pascal en vers du vba.

je rappelle le code initial:

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
 
 
 
 
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 :

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
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 .