Faire un double tirage de poules

**jacfld49** · 23/08/2009, 18h05

bonjour le forum,

Voici un code qui me permet de faire un tirage aléatoire de poules qui l'envoie sur la Feuile Série de mon fichier en B7:R13 et ma question est : set-il possible de faire en même temps un autre tirage aléatoire à partir de cette macro qui se place par contre en B17:R23.

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
Sub testSMF1()
Dim deja(200) As Boolean
Dim tablo(200)
Randomize       'utilise l'heure system pour Rnd
nb = Feuil4.[A6].End(xlDown).Row - 6 'nombre joueurs
For k = 1 To nb 'création tablo de 1 à nb aléatoire
  Do
    n = Int((nb * Rnd) + 1)
    If deja(n) = False Then
     deja(n) = True
     tablo(k) = n
     Exit Do
    End If
  Loop
Next
Sheets("Série").Range("B7:R13").ClearContents
If Range("Q5") <> "" Then
  nombredepoules = Range("Q5")
Else
  MsgBox ("Donnez le nombre de poules")
  Exit Sub
End If
ligne = 7
col = 2
pas = 3
For n = 7 To Range("A65536").End(xlUp).Row
  Sheets("Série").Cells(ligne, col) = Range("A" & tablo(n - 6) + 6)
  col = col + pas
  If col = 2 + 3 * nombredepoules Or col = -1 Then
    ligne = ligne + 1
    col = col - pas
    pas = -pas
  End If
Next n
Sheets("Série").Select
Application.Calculation = xlCalculationAutomatic
End SubVoici ma question

merci d'avance
jacky

**mercatog** · 23/08/2009, 23h00

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
Public Sub testSMF1(ByVal s as byte)  's=0 pour B7:R13 et s=1 pour B17:R23
Dim deja(200) As Boolean
Dim tablo(200)
Randomize       'utilise l'heure system pour Rnd
nb = Feuil4.[A6].End(xlDown).Row - 6 'nombre joueurs
For k = 1 To nb 'création tablo de 1 à nb aléatoire
  Do
    n = Int((nb * Rnd) + 1)
    If deja(n) = False Then
     deja(n) = True
     tablo(k) = n
     Exit Do
    End If
  Loop
Next
Sheets("Série").Range("B7:R13").ClearContents
If Range("Q5") <> "" Then
  nombredepoules = Range("Q5")
Else
  MsgBox ("Donnez le nombre de poules")
  Exit Sub
End If
ligne = 7 + 10*s          '>----------ICI CHANGEMENT
col = 2
pas = 3
For n = 7 To Range("A65536").End(xlUp).Row
  Sheets("Série").Cells(ligne, col) = Range("A" & tablo(n - 6) + 6)
  col = col + pas
  If col = 2 + 3 * nombredepoules Or col = -1 Then
    ligne = ligne + 1
    col = col - pas
    pas = -pas
  End If
Next n
Sheets("Série").Select
Application.Calculation = xlCalculationAutomatic
End Sub

Pour la première plage tu appelle la procédure:

Code :

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

testSMF1 0

pour la seconde:

Code :

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

testSMF1 1

J'ai pas pu voir à l'intérieur

**jacfld49** · 23/08/2009, 23h01

bonsoir,
je m'explique, j'ai un double tirage mais la par contre ce sont pour les séries mais aléatoirement car actuellement, je fais 2 tirages séparé mais j'aimerais avoir la possibilité avec le même bouton d'activer les 2 codes ou les rassembler mais ceci est peut etre impossible.
mais impossible n'existe pas sur ce forum, je crois en tous cas , j'ai toujours vu des solutions au post surtout avec celui qui vient d'être résolu grace à jfontaine et surtout mercatog
D'ailleurs, il faut que j'aille mettre résolu dessus .
merci
jacky

**mercatog** · 23/08/2009, 23h04

tu mets le code que j'ai peu modifié dans un module public

sur ton bouton, tu mets cela:

Code :

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

1
2
3
4
Private Sub TonBouton_OnClick()
testSMF1 0
testSMF1 1
End Sub

**jacfld49** · 23/08/2009, 23h10

re,

la j'ai un problème car j'ai copié tes 2 codes dans des modules différents comme tu m'as dit(si j'ai bien compris) mais je n'arrive pas à affecter une macro au bouton.
jacky

**mercatog** · 23/08/2009, 23h12

Par contre, maintenant la procédure dans un module public, il faut donner à chaque Range la feuille où il est placé
Exemple

Code :

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

Sheets("Série").Cells(ligne, col) = Range("A" & tablo(n - 6) + 6)

de quelle feuille ce Range
il faut mettre:

Code :

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

Sheets("Série").Cells(ligne, col) = Sheets("XXXX").Range("A" & tablo(n - 6) + 6)

"XXXX" le nom de la feuille en question

La première procédure dans un module public

à ton bouton, tu applique sur évènement OnClick les 2 lignes

**jacfld49** · 23/08/2009, 23h15

re,
si j'ai bien compris, je mets ces codes dans les feuilles concernés??
merci
jacky

**mercatog** · 23/08/2009, 23h24

Non Non:
tu mets cela dans un module public

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
Public Sub testSMF1(ByVal s as byte)  's=0 pour B7:R13 et s=1 pour B17:R23
Dim deja(200) As Boolean
Dim tablo(200)
Randomize       'utilise l'heure system pour Rnd
nb = Feuil4.[A6].End(xlDown).Row - 6 'nombre joueurs
For k = 1 To nb 'création tablo de 1 à nb aléatoire
  Do
    n = Int((nb * Rnd) + 1)
    If deja(n) = False Then
     deja(n) = True
     tablo(k) = n
     Exit Do
    End If
  Loop
Next
Sheets("Série").Range("B7:R13").ClearContents
If Range("Q5") <> "" Then
  nombredepoules = Range("Q5")
Else
  MsgBox ("Donnez le nombre de poules")
  Exit Sub
End If
ligne = 7 + 10*s          '>----------ICI CHANGEMENT
col = 2
pas = 3
For n = 7 To Range("A65536").End(xlUp).Row
  Sheets("Série").Cells(ligne, col) = Range("A" & tablo(n - 6) + 6)
  col = col + pas
  If col = 2 + 3 * nombredepoules Or col = -1 Then
    ligne = ligne + 1
    col = col - pas
    pas = -pas
  End If
Next n
Sheets("Série").Select
Application.Calculation = xlCalculationAutomatic
End Sub

Tu dois le corriger en affectant à chaque Range, la feuille: comme ça:

Code :

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

Sheets("LaFeuilleDuRange").Range(X)

(facultatif je pense)

ensuite,
sur ta feuille tu crée un bouton de commande issu de la boite à outils Contrôles.
Tu clique droit puis visualiser le code
tu auras:

Code :

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

Private Sub NomDeTonBouton_Click()

Tu écris cela:

Code :

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

1
2
3
4
Private Sub NomDeTonBouton_Click()
   testSMF1 0
    testSMF1 1
End Sub

**jacfld49** · 23/08/2009, 23h28

re,

Qu'appelle tu un module public, moi j'ai inséré un module et mis le code dedans.
merci
jacky

**mercatog** · 23/08/2009, 23h31

C'est ça un module public.

c'est à dire disponible de n'importe quel endroit de ton classeur.

**jacfld49** · 23/08/2009, 23h32

re,
la feuille du Range, c'est la feuille ou vont se ranger les poules ou bien la feuille ou l'on prends les données.
merci
jacky

re,
parce que la, je viens de mettre le code pour le bouton que j'ai appelé SérieSMF mais rien ne se passe .
Je n'ai pas l'air très duoé et moi qui pensais me débrouiller, je vois tout le travail qui me reste à faire . Ouille ouille;
merci
jacky

**mercatog** · 23/08/2009, 23h37

ça dépend du code.

Essayons de tester avant de régler s'il y aura des problèmes de Range.
Fais ton bouton dans ta feuille X

ce Range("Q5") de cette ligne de code par exemple fera référence à ta feuille X

Code :

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

1
2
3
If Range("Q5") <> "" Then
  nombredepoules = Range("Q5")
Else

Tu as un fichier exemple?
cette fois et seulement cette fois je ferai cela à ta place!

**jacfld49** · 23/08/2009, 23h45

RE,
le voici et merci d'avance, tu va voir , j'ai essayé mais je vais bien sur la feuille série mais la rien!!
merci
jacky

**jacfld49** · 23/08/2009, 23h58

re,
il me met aussi en passant dans la feuille Série : Donnez le Nombre de poules alors que je l'ai fait.
merci
jacky

**mercatog** · 24/08/2009, 00h11

Effectivement, tu n'avais pas de bouton

J'ai fais des changements de ton code
et voilà le résultat!

**mercatog** · 24/08/2009, 00h17

Dans le code Module 17 tu corrige cette ligne:

Code :

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

Sheets("Série").Range("B" & 7 + 10 * s & ": R" & 12 + 10 * s).ClearContents

12 au lieu de 23

et enlève le

Code :

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

MsgBox Ligne

J'ajoute qu'il faut changer comme cela la procédure comme cela:

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
Option Explicit
Public Sub testSMF(ByVal s As Byte)  's=0 pour B7:R13 et s=1 pour B17:R23
Dim deja(200) As Boolean
Dim tablo(200) As Integer
Dim sht As Worksheet
Dim n As Integer, nb As Integer, k As Integer, nombredepoules As Integer
Dim Ligne As Integer, Col As Integer
 
Set sht = Sheets("SMF")
 
Randomize                                       'utilise l'heure system pour Rnd
nb = sht.Range("A65536").End(xlUp).Row - 6      'nombre joueurs
 
For k = 1 To nb                                 'création tablo de 1 à nb aléatoire
    Do
        n = Int((nb * Rnd) + 1)
        If deja(n) = False Then
            deja(n) = True
            tablo(k) = n
            Exit Do
        End If
    Loop
Next
 
Sheets("Série").Range("B" & 7 + 10 * s & ": R" & 12 + 10 * s).ClearContents
If sht.Range("R5") = "" Then MsgBox "Saisissez dans R5 le nombre de poules, je crois que c'est: " & Application.WorksheetFunction.RoundUp(nb / 6, 0)
 
sht.Range("R5") = Application.WorksheetFunction.RoundUp(nb / 6, 0)
nombredepoules = sht.Range("R5")
 
 
Ligne = 7 + 10 * s
Col = 2
 
For n = 7 To nb + 6
    Sheets("Série").Cells(Ligne, Col) = sht.Range("A" & tablo(n - 6) + 6)
    Col = Col + 3
    If Col = 2 + 3 * nombredepoules Then
        Ligne = Ligne + 1
        Col = 2
    End If
Next n
 
Sheets("Série").Select
Application.Calculation = xlCalculationAutomatic
Set sht = Nothing
End Sub

**jacfld49** · 24/08/2009, 07h15

Bonjour le forum,mercatog,

Juste avant de partir au travail, c'est à peu près ça , sauf que sur les 2 tirages qu'il me fait et me place en feuille Série, il ne me met que 7 partants à chaque tirage alors que j'en ai 13 et donc il devrait pour chaque tirage m'en mettre 13 : le 1er tirage placé en Bè:R13 et l'autre en B17:R23.J'espère qu'on va y arriver.
merci et bonne journée
jacky

**mercatog** · 24/08/2009, 09h56

Effectivement après avoir posté ton fichier, j'avais remarqué cela. mais tu n'avais pas lis mon dernier post. (Tu t'es endormi sans dire bonne nuit!!!).
Il me faut mettre ici la dernière version du code 2 fois pour que tu t''en aperçoives

. Re voilà encore la dernière version du code que j'avais un peu modifié. Certes il y a d'autres manières plus cartésiennes pour faire cela; mais bon!

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
Option Explicit
Public Sub testSMF(ByVal s As Byte)  's=0 pour B7:R13 et s=1 pour B17:R23
Dim deja(200) As Boolean
Dim tablo(200) As Integer
Dim sht As Worksheet
Dim n As Integer, nb As Integer, k As Integer, nombredepoules As Integer
Dim Ligne As Integer, Col As Integer
 
Set sht = Sheets("SMF")
 
Randomize                                       'utilise l'heure system pour Rnd
nb = sht.Range("A65536").End(xlUp).Row - 6      'nombre joueurs
 
For k = 1 To nb                                 'création tablo de 1 à nb aléatoire
    Do
        n = Int((nb * Rnd) + 1)
        If deja(n) = False Then
            deja(n) = True
            tablo(k) = n
            Exit Do
        End If
    Loop
Next
 
Sheets("Série").Range("B" & 7 + 10 * s & ": R" & 12 + 10 * s).ClearContents
If sht.Range("R5") = "" Then MsgBox "Saisissez dans R5 le nombre de poules, je crois que c'est: " & Application.WorksheetFunction.RoundUp(nb / 6, 0)
 
sht.Range("R5") = Application.WorksheetFunction.RoundUp(nb / 6, 0)
nombredepoules = sht.Range("R5")
 
 
Ligne = 7 + 10 * s
Col = 2
 
For n = 7 To nb + 6
    Sheets("Série").Cells(Ligne, Col) = sht.Range("A" & tablo(n - 6) + 6)
    Col = Col + 3
    If Col = 2 + 3 * nombredepoules Then
        Ligne = Ligne + 1
        Col = 2
    End If
Next n
 
Sheets("Série").Select
Application.Calculation = xlCalculationAutomatic
Set sht = Nothing
End Sub

Ceci, il faut le mettre à la place de l'ancien code (qui était dans le fichier exemple dans le Module 17).

**jacfld49** · 24/08/2009, 16h49

bonjour le forum,Mercatog,

Non, ce n'est pas que je suis allé au lit sans dire merci,c'est que je suis sur mon Portable et je n'avais plus de batterie donc il s'est éteint et mon chargeur était sur l'ordi à mon fils ainé qui est en vacances à la maison et as oublié le sien. Donc , je lui ai dit avant d'allé me couché de le rebrancher sur le mien et je ne l'ai rallumé que ce matin à 7h00.
merci à toi, je test le code pour voir si c'est bon et te redis .
jacky

re,

Encore un grand grand merci à toi Mercatog car cela fonctionne impeccable.
Je voulais juste un autre renseignement que je ferais moi même car comme j'ai plusieurs feuille (ex:SMF,SMG etc...)et qu'il faut que je fasse le même code pour ces feuilles et qu'il se classe aussi en feuille Série mais par ex pour SMG, il se classe en B30:R36 et B40:R46, je pense qu'il faut que je change les valeurs de la ligne: Sheets("Série").Range("B" & 7 + 10 * s & ": R" & 12 + 10 * s).ClearContents en: Sheets("Série").Range("B" & 30 + 10 * s & ": R" & 35 + 10 * s) mais j'aimerais être sur .
merci beaucoup pour le temps que tu me consacres et encore un grand merci pour ce que tu as fait.
jacky

RE,

Juste une dernière petite chose, mais seulement s'il ne faut pas tous changer.
(Et j'ai une réunion d'ici 15 à 20 jours , je me renseignerais)mais :
Est il possible de choisir nous même le nbrs de Poules en R5 plutôt que ce soit le code qu'il le fait lui même car je viens de faire un essai avec 16 partants et il me fait une poule de 6 et 2 poules de 5 qui me vont bien mais il est possible que l'on me demande d'équilibrer les poules et donc de 4 poules de 4.
merci
jacky

**mercatog** · 24/08/2009, 17h43

Bonjour Jacques, c'est bien ça?
Je rigolais concernant le "sans dire bonne nuit". c'est pas nécessaire!

Pour ta nouvelle question, peux tu spécifier davantage ce que tu veux faire?

Nous venons de créer une procédure publique avec seul paramètre le n° de tirage (1 ou 2)! cette procédure est lancée de la feuille SMF
Maintenant, tu veux lancer cette de la feuille SMG (c'est tout ou à partir d'autres feuilles); nous devons réfléchir ce que nous devons écrire à la procédure pour qu'elle comprenne.

tout d'abord au lieu du chiffre 7 nous allons mettre une variable

Code :

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

1
2
3
4
Sheets("Série").Range("B" & 7 + 10 * s & ": R" & 12 + 10 * s).ClearContents
.....
Ligne = 7 + 10 * s
.....

C'est à dire nous allons déclarer une variable DebZone
et en fonction de la feuille de lancement lui affecter 7 si c'est à partie de SMF et 30 si c'est à partir de SMG

Nous aurons dans ces lignes le code suivant

Code :

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

1
2
3
4
Sheets("Série").Range("B" & DebZone + 10 * s & ": R" & DebZone+5 + 10 * s).ClearContents  
.....
Ligne = DebZone + 10 * s
.....

Avant ces ligne, à la variable DebZone est affecté un chiffre, 7 ou 30

Faire un double tirage de poules

Macros et VBA Excel

Discussions similaires

Partager

Partager