transcription d'un pascal en vba

**didier.schmit** · 09/05/2009, 07h57

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 .

**oscar.cesar** · 11/05/2009, 20h43

bonsoir au forum
je reprends un post precedent qui me parait interessant concernant le passage d'un code de pascal en VBA
DAns ca version VBA apres quelque retouche j'ai une erreur de compilation
dans la declaration

Code :

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

1
2
3
4
5
6
7
 
 
Type TCombinaison
    Necessaire As Boolean
    Tirage(0 To 5) As Byte 'taille de la combinaison
 
   End Type

ci joint la totalite du 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
144
145
146
147
148
149
 
  '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
 
 
 Dim AValeurMax As Integer
 Dim ASelection As Integer
 
 
Type TCombinaison
    Necessaire As Boolean
    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
    Dim j As Integer, k As Integer, l As Integer, m As Integer, n As Integer, o 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
 
 
 
 
    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
 
 
 
 
 
 
 
 
 
    nb_numeros_tires = 6     ' on part de cette base pour le loto 6
    nb_numeros_max = 49     '49 pour le loto
    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 Function
 
Private Sub CommandButton1_Click(
 
Call Combinaison(AValeurMax, ASelection)
End Sub

un coup de main de la part de nos experts seraient appréciés.

merci par avance

**Pierre Fauconnier** · 11/05/2009, 20h57

Bonjour

Il y a à tout le moins un problème ici

Code :

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

1
2
3
4
Private Sub CommandButton1_Click(
 
Call Combinaison(AValeurMax, ASelection)
End Sub

**oscar.cesar** · 11/05/2009, 21h49

bonsoir pierre

je comprends pas , desolé

Il y a à tout le moins un problème ici

Code :

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

1
2
3
4
5
 
Private Sub CommandButton1_Click(
 
Call Combinaison(AValeurMax, ASelection)
End S

**Pierre Fauconnier** · 11/05/2009, 21h59

Je n'ai pas d'erreur de compilation au niveau du Type.

Par contre, la ligne de la proc

Code :

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

Private Sub CommandButton1_Click(

n'est pas complète, il manque la parenthèse fermante.

Peux-tu préciser à quel niveau tu as le problème de compilation?

**ilank** · 11/05/2009, 22h10

Bonsoir,

dans un premier temps ,

Code :

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

1
2
3
4
Public Function Factoriel(n as long) as double
 If n=1 Then Factoriel=n :Exit function
 Factoriel=n*Factoriel(n-1)
End function

à partir de là le calcul des combinaisons avec la formule : n!/p!*(n-p)!
on a

Code :

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

1
2
3
4
Public Function Combinaison(n as long, p as long) as double
 If n<p Then Exit function
 Combinaison=Factoriel(n)/(Factoriel(n-p)*Factoriel(p))
End function

**oscar.cesar** · 11/05/2009, 22h30

bonsoir
desole mais chez moi j'ai l'erreur
ci joint le fichier que j'ai
je suis sous excel 2002 (10.6850.2625)

**oscar.cesar** · 13/05/2009, 18h35

bonsoir à tous, ilank

merci de tes reponses .

le point 1 :
je souhaiterai faire marcher le programmme et donc comprendre pourquoi à la compilation j'ai l'erreur sur le point que j'ai expose dans mon post precedent

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
'Lecture des combinaisons et affichage dans une boîte de message
'Pour éviter de lire toutes les combinaisons cliquer Non pour sortir
Public Sub ReadLoto()

    Dim i As Long
    For i = 1 To combinaison(nLoto, ploto)
       If MsgBox("Combinaison  n°" & i & "/" & combinaison(nLoto, ploto) & vbCrLf & "{" & NumeroCur.ReadValue & "}", vbYesNo) = vbNo Then Exit For
        NumeroCur.Incremente
    Next i
End Sub

le debuggeur s'arret sur combinaison avec le message suivant :

ERREUR COMPILATION SUB OU FUNCTIONnon define

hors, j'ai regardé dans le corps principal, elle semble bien presente .

Je comprends pas

Code :

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

1
2
3
4
5
6
7
8
9
10
 
 
...........
'Calcul du nombre de combinaisons : (n!/(n-p)!) * p!
Public Function combinaison(n As Integer, p As Integer) As Long
    If n < p Then Exit Function
    combinaison = Factoriel(n, n - p) / Factoriel(p)
End Function
 
End Function

le 2 point sur les SR , autrement dit les SYSTEMES REDUCTEURS.
je rentrerai pas dans les demonstrations mathematiques , car mon niveau ne le permettrait pas.
Les systèmes réducteurs permettent au joueur, en combinant plusieurs grilles de jeu, de couvrir une combinaison de nombres souhaités selon une garantie pré-établie,

ex pour le loto :
SOIt une combinasion de taille 6 donc composée de 6 n°, Supposons que nous choisisons un système reducteur 3/3 Cela signifie que, si vous n’avez trouvé que 3 numéros, une des combinaisons en contiendra 3 (3/3).
si tu souhaites plus d'infos j'ai quelques sites et documents sur le sujet.

DOnc pour en revenir au programme , j'ai cru comprendre qu'il permettait de construire de tels systemes.

merci de ton aide

**ilank** · 13/05/2009, 20h25

bonsoir,

Envoyé par oscar.cesar

ex pour le loto :
SOIt une combinasion de taille 6 donc composée de 6 n°, Supposons que nous choisisons un système reducteur 3/3 Cela signifie que, si vous n’avez trouvé que 3 numéros, une des combinaisons en contiendra 3 (3/3).
si tu souhaites plus d'infos j'ai quelques sites et documents sur le sujet.

Je ne comprends pas. Faut-il rechercher les combinaisons qui contiennent les 3 numéros ?
Concernant le problème, essaie de compiler après enregistrement et réouverture du fichier.

**oscar.cesar** · 13/05/2009, 20h40

bonsoir illank le forum

pour l'erreur de compilation , j'ai tout essayé dans mon perimetre de competence.

Eventuellement peux tu mettre ton fichier dans le prochain post

merci d'avance

**oscar.cesar** · 13/05/2009, 20h50

rebonsoir

pour repondre à ta question
oui il faut parmi toute les combinaisons de taille 6 rechercher tous les trios (3) enlimant les doublons et ceux si on a 3 bons numeros .

donc garantie 3/3 pour des combinaison compose de 6 n°

**oscar.cesar** · 14/05/2009, 19h41

bonsoir
je viens d'essayer sur une excel 2007 les divers codes presents dans les posts precedents j'ai toujours les memes erreurs.

transcription d'un pascal en vba

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager