Tirage au sort

[em34]

bonjour,

je cherche à réaliser un tirage au sort dont les hypothèses sont :

24 joueurs,
repartis par table de 4 joueurs (donc 6 tables)
et je voudrais faire 5 roulements (soit 6 parties).

à chaque roulement, tous les joueurs changent de table.

il faudrait qu'après les 6 parties, aucun joueur ne se soit rencontré 2 fois.

merci d'avance.

Eric

 

[ROGER2327]

Re : Tirage au sort

Bonjour à tous

Petit problème avec le fichier de em34 : la fonction ALEAS() n'y est pas définie.

Une proposition dans le classeur joint sur la base de cette fonction :

[B][COLOR="DarkSlateGray"]Function UNIQUE(mn&, mx&, Optional st& = 1)
[COLOR="DarkRed"]'
'      23 Fructidor CCXVIII      -      ROGER2327 fecit.      '
'[/COLOR]
Dim i&, al&(), oColl As New Collection
   Application.Volatile
   Randomize
   For i = mn To mx Step WorksheetFunction.Max(st, 1)
      oColl.Add Item:=i
   Next
   ReDim al(1 To oColl.Count, 1 To 1)
   For i = oColl.Count To 1 Step -1
      al(i, 1) = oColl(1 + Int(i * Rnd()))
      oColl.Remove 1 + Int(i * Rnd(0))
   Next i
   UNIQUE = al
End Function[/COLOR][/B]

C'est une fonction matricielle.

mn est un entier.
mx est un entier supérieur à mn.
st est un entier strictement positif. Ce paramètre est optionnel. Sa valeur par défaut est 1.
=UNIQUE(mn;mx;st) renvoie une matrice colonne d'entiers distincts de la forme

mn + k * st où k = 0, 1, 2, ..., ent[(mx - mn) / st]​

dans un ordre aléatoire.​

Exemples :

=UNIQUE(1;8) renvoie 4 7 3 6 2 5 1 8
=UNIQUE(3;9;2) renvoie 7 5 9 3​

ROGER2327
#4095

Lundi 2 Absolu 138 (Saint Ptyx, silentiare (Abolition de), SQ)
23 Fructidor An CCXVIII
2010-W36-4T15:09:52Z

 

[malizia]

Re : Tirage au sort

Merci c 'est exatement ça que je souhaite mon seul probleme est que le bouton F9 ne fonction pas je ne comprend pas pourquoi, Mais une fois le probleme du bouton f9 reparer vais pouvoir commencer a travailler ^^

 

[em34]

Re : Tirage au sort

bonjour,

désolé, j'ai omis de préciser que la fonction "aleas" était issue d'un pack de fonctions complémentaires "MOREFUNC", à télécharger et à installer, suivre le lien suivant :

Télécharger MOREFUNC (Macro complémentaire EXCEL) (gratuit)

 

[ROGER2327]

Re : Tirage au sort

Bonjour à tous

Une version avec un bouton dans le classeur joint.​

ROGER2327
#4105

Mardi 3 Absolu 138 (Saint Phénix, solipsiste et Saint Hyx, factotum, SQ)
24 Fructidor An CCXVIII
2010-W36-5T08:48:46Z

 

[pierrejean]

Re : Tirage au sort

Bonjour a tous

@ ROGER

J'avais pondu quelque chose a base de Randomize et rnd
mais apres avoir vu votre Version2 j'aurais honte de la publier
Pouvez vous eclairer ma lanterne quant a l'obtention de l'alea du resultat ?
Et en tout etat de cause Grand Merci pour l'Array( Array....) que je decouvre

 

[ROGER2327]

Re : Tirage au sort

Bonsoir à tous

À em34 :

(...) la fonction "aleas" était issue d'un pack de fonctions complémentaires "MOREFUNC" (...)

Merci pour l'information. N'utilisant pas ce complément, il ne m'est pas venu à l'idée que la fonction ALEAS en faisait partie.​

À pierrejean :

(...) Pouvez vous eclairer ma lanterne quant a l'obtention de l'alea du resultat ? (...)

Oui, bien sûr !
Éclairons : le code utilisé dans la procédure fait appel à la fonction UNIQUE, qu'on trouve dans le module Module1. La partie de génération aléatoire est dans cette fonction. (On y trouve évidemment les instructions Randomize et Rnd.)
Comme j'utilise aussi la fonction UNIQUE dans le bouton de la feuille Version_1, j'ai procédé ainsi pour ne pas avoir à répéter le codage dans chaque bouton. (C'est ce qu'on peut appeler le principe de modularité : si un code doit servir plusieurs fois, autant en faire une fonction autonome...)

D'autre part, je vous remercie de votre message, qui m'a fait rouvrir le classeur... ...et découvrir que je n'ai pas déposé le bon classeur.
Le code qui y figure est un code de développement écrit pour suivre les opérations pas à pas : écriture des formules dans la feuille, puis remplacement des dites formules par les valeurs qu'elles engendrent.
Une fois que j'ai pu contrôler pas à pas que le code faisait bien ce que j'en attendais, j'ai écrit une version plus compacte en éliminant le superflu. Mais j'ai oublié de la coller dans le classeur définitif !

Voici le code final :​

Module de la feuille Version_1 :

[COLOR="DarkSlateGray"][B]Private Sub CommandButton1_Click()
[COLOR="SeaGreen"]'
' 24 Fructidor CCXVIII - ROGER2327 fecit. '
'[/COLOR]
Dim i&, aPlg()
[COLOR="SeaGreen"]   'Paramètre à adapter selon les besoins :[/COLOR]
   aPlg = Array(Array("C5:C12", 1, 8, 1), Array("C14:C21", 1, 8, 1), Array("C23:C30", 1, 8, 1), Array("C32:C39", 1, 8, 1))
   [COLOR="SeaGreen"]'[/COLOR]
   For i = 0 To UBound(aPlg)
      Range(aPlg(i)(0)).Value = UNIQUE(aPlg(i)(1), aPlg(i)(2), aPlg(i)(3))
   Next
End Sub[/B][/COLOR]

Module de la feuille Version_2 :

[COLOR="DarkSlateGray"][B]Private Sub CommandButton1_Click()
[COLOR="SeaGreen"]'
' 24 Fructidor CCXVIII - ROGER2327 fecit. '
'[/COLOR]
Dim i&, j&, aPlg(), al()
   [COLOR="SeaGreen"]'Paramètre à adapter selon les besoins :[/COLOR]
   aPlg = Array(Array("B5:B12", 1, 8, 1, "E5:L5"), Array("B14:B21", 1, 8, 1, "E6:L6"), Array("B23:B30", 1, 8, 1, "E7:L7"), Array("B32:B39", 1, 8, 1, "E8:L8"))
   [COLOR="SeaGreen"]'[/COLOR]
   For i = 0 To UBound(aPlg)
      al = WorksheetFunction.Transpose(UNIQUE(aPlg(i)(1), aPlg(i)(2), aPlg(i)(3)))
      For j = 1 To UBound(al): al(j) = Range(aPlg(i)(0))(al(j)): Next j
      Range(aPlg(i)(4)) = al
   Next i
End Sub[/B][/COLOR]

Module standard Module1 :

[COLOR="DarkSlateGray"][B]Function UNIQUE(ByVal mn&, ByVal mx&, Optional ByVal st& = 1)
[COLOR="SeaGreen"]'
' 23 Fructidor CCXVIII - ROGER2327 fecit. '
'[/COLOR]
Dim i&, al&(), oColl As New Collection
   Application.Volatile
   Randomize
   For i = mn To mx Step WorksheetFunction.Max(st, 1)
      oColl.Add Item:=i
   Next
   ReDim al(1 To oColl.Count, 1 To 1)
   For i = oColl.Count To 1 Step -1
      al(i, 1) = oColl(1 + Int(i * Rnd()))
      oColl.Remove 1 + Int(i * Rnd(0))
   Next
   UNIQUE = al
End Function[/B][/COLOR]

Cordialement,​

ROGER2327
#4106

Mardi 3 Absolu 138 (Saint Phénix, solipsiste et Saint Hyx, factotum, SQ)
24 Fructidor An CCXVIII
2010-W36-5T19:43:13Z

 

[pierrejean]

Re : Tirage au sort

Re

Merci beaucoup ROGER
Il ne m'etait pas venu a l'idée que UNIQUE soit une fonction personnalisée (d'autant qu'elle etait appelée a l'interieur d'une WorksheetFunction)
Du coup ,je me torturais pour savoir d'ou etait issu l'alea

Par ailleurs voici ce que j'avais pondu avec non pas une fonction mais une sub appelée plusieurs fois