Tirage au sort aléatoire pour la pétanque

natorp

XLDnaute Accro
bonsoir à tous et toutes,

J'ai regardé plusieurs fils, mais je n'ai pas trouvé ce que je cherche
A partir d'une liste (colonne A) créer de façon aléatoire les doublettes d'un tournoi de pétanque en évitant les doublons et d'associer 2 femmes ensemble (critères en colonne B)

j'ai joins un fichier pour travailler, j'ai bien vu qu'il existe une fonction ALEA mais je ne sais pas comment m'en servir... et si cela est la bonne piste...

merci de votre aide et attention, cordialement, Gérard
 

Pièces jointes

  • Classeur1.xls
    16.5 KB · Affichages: 1 486
  • Classeur1.xls
    16.5 KB · Affichages: 1 483
  • Classeur1.xls
    16.5 KB · Affichages: 1 472

JBARBE

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

J'ai supprimer des colonnes inutiles dans l'onglet " Tableau Tournante "

D'autre part dans l'onglet "Impression" pour ne plus avoir #N/A voir cellule C17 la modification à prendre en compte pour toutes ces cellules :

=SI(ESTNA(RECHERCHEV(C16;'Tableau Tournante'!$A$6:$B$168;2));"")

PS : le fichier n'est pas trop gros pour le mettre sur ce forum !!!!!!

bonne journée !
 

Pièces jointes

  • copie Tournante Pétanque ALENYA.xlsm
    482.4 KB · Affichages: 176

JOAN66

XLDnaute Junior
Re : Tirage au sort aléatoire pour la pétanque

Merci pour la réponse . si je prends la cellule "C17" avec la poignet a "D17" " Faux" est dans la cellule à la place du nom ?.
Pour le fichier désolé il na pas voulu le prendre en pièce jointe .
Cordialement
 

Dranreb

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

Bonjour.
Pour sortir la feuille Impression en même temps, ajouter ce paquet à la fin de la procédure Tirage22
VB:
Rem. ——— Mise en forme et affichage pour l'impression
Dim Noms(): Noms = Feuil1.[B6].Resize(JMax).Value
Set PlgRés = Feuil2.[C8].Resize(320, 23)
ReDim TAff(1 To PlgRés.Rows.Count, 1 To PlgRés.Columns.Count)
For L = 1 To LMax: For M = 1 To MMax: For C = 1 To 4
   If Tirage(M, L, C) <> 0 Then
      TAff(L * 2 - 1, 6 * (M - 1) + (C * 3 - 1) \ 2) = Tirage(M, L, C)
      TAff(L * 2, 6 * (M - 1) + (C * 3 - 1) \ 2) = Noms(Tirage(M, L, C), 1)
      End If
   Next C, M, L
PlgRés.Value = TAff
PlgRés.Rows.AutoFit ' éventuellement
Feuil2.PageSetup.PrintArea = Feuil2.[C1].Resize(4 + LMax * 2, MMax * 6 - 1).Address
End Sub
Je supprimerais les bordures supérieures des lignes de noms pour qu'il n'y ait aucune confusion quant à ce qu'il concerne ne numéro au dessus ou en dessous.

Tiens, je viens de découvrir qu'il y a un UserForm de présentation, apparemment, avec une photo et un texte. EXcelDownloads n'y est pas mentionné !?
 
Dernière édition:

JOAN66

XLDnaute Junior
Re : Tirage au sort aléatoire pour la pétanque

oui ! tu a raison, c'est un essai a l'ouverture du Tableau pour remercier les pro d'Excel-Donwload pour leur aimable gentillesse a la participation de la création des macros, mais il y a eu une erreur , milles excuses.
Sur la photos il y a les joueurs donc celui qui vous a donné du travail (le 3eme de gauche).
Je colle tout de suite le Paquet afin de tester la macro
pour supprimer les " ERREUR - #N/A "
=SI(C16=0;"";RECHERCHEV(C16;'Tableau Tournante'!$A$6:$B$168;2))
et la recherche cellules vides peut se réaliser.
Cordialement Joan
 

JOAN66

XLDnaute Junior
Re : Tirage au sort aléatoire pour la pétanque

Ne cherche plus je viens de faire une impression par les cellules vides et ça fonctionne .

Une fois le tableau fini je le ferai parvenir au forum afin de vous faire voir la réalisation complète .
Il reste des protections à mettre en place pour sécuriser tableau et macro , ensuite se sera bon .
Merci encore
Cordialement Joan
 

Dranreb

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

Il n'y a plus de formule, ni à tenir compte ou pas de cellules vides.

Mais attention, il y a une erreur dans la toute dernière instruction qui met en place la zone d'impression.
C'est :
VB:
Feuil2.PageSetup.PrintArea = Feuil2.[C1].Resize(7 + LMax * 2, MMax * 6 - 1).Address
Il y avait un 4 à la place du 7 parce que j'avais bêtement compté les lignes des cellules que je voyais, et bien sûr je ne voyais pas les lignes de hauteur nulle.

Le module MTirage22 complet est maintenant comme ça :
VB:
Option Explicit
Dim MMax As Long, LMax As Long, Tirage() As Long, JoueursManche() As ListeAléat, _
     DéjàRenc() As Boolean, DéjàPart() As Boolean, DéjàTêtÀTête() As Boolean
'
   
Sub Tirage22()
Dim JMax As Long, M As Long, PlgRés As Range, TAff(), _
    L As Long, C As Long, Noms()

Rem. ——— Initialisations des conditions de la rencontre.
JMax = Feuil1.[B170].End(xlUp).Row - 5
If JMax Mod 2 = 1 Then
   MsgBox "Tirage non applicable pour un nombre impair de participants.", _
   vbCritical, "Tirage22": Exit Sub: End If
MMax = IIf(JMax <= 8, 3, 4)

Rem. ——— Initialisations pour le tirage
LMax = (JMax + 2) \ 4
ReDim DéjàRenc(0 To XTria(JMax, JMax - 1)), _
      DéjàPart(0 To XTria(JMax, JMax - 1)), _
      DéjàTêtÀTête(1 To JMax), JoueursManche(1 To MMax), _
      Tirage(1 To MMax, 1 To LMax, 1 To 4)
Randomize
For M = 1 To MMax: Set JoueursManche(M) = New ListeAléat
   JoueursManche(M).Init JMax: Next M

Rem. ——— Tirage
If Not RencTrouvée(1, 1) Then MsgBox "Pas de solution trouvée.", vbExclamation, "Tirage22": Exit Sub

Rem. ——— Mise en forme et affichage du résultat
Set PlgRés = Feuil1.[D6:S159]
ReDim TAff(1 To PlgRés.Rows.Count, 1 To PlgRés.Columns.Count)
For L = 1 To LMax: For M = 1 To MMax: For C = 1 To 4
   If Tirage(M, L, C) <> 0 Then TAff(L, 4 * (M - 1) + C) = Tirage(M, L, C)
   Next C, M, L
PlgRés.Value = TAff

Rem. ——— Mise en forme et affichage pour l'impression
Noms = Feuil1.[B6].Resize(JMax).Value
Set PlgRés = Feuil2.[C8].Resize(320, 23)
ReDim TAff(1 To PlgRés.Rows.Count, 1 To PlgRés.Columns.Count)
For L = 1 To LMax: For M = 1 To MMax: For C = 1 To 4
   If Tirage(M, L, C) <> 0 Then
      TAff(L * 2 - 1, 6 * (M - 1) + (C * 3 - 1) \ 2) = Tirage(M, L, C)
      TAff(L * 2, 6 * (M - 1) + (C * 3 - 1) \ 2) = Noms(Tirage(M, L, C), 1)
      End If
   Next C, M, L
PlgRés.Value = TAff
PlgRés.Rows.AutoFit 'éventuellement
Feuil2.PageSetup.PrintArea = Feuil2.[C1].Resize(7 + LMax * 2, MMax * 6 - 1).Address
End Sub
'

Private Function RencTrouvée(ByVal M As Long, ByVal L As Long) As Boolean
Dim J1 As Long, PosJ2 As Long, J2 As Long, PosA1 As Long, A1 As Long, PosA2 As Long, A2 As Long, _
   xJ1J2 As Long, xJ1A1&, xJ1A2&, xJ2A1&, xJ2A2&, xA1A2&
If L > LMax Then L = 1: M = M + 1: If M > MMax Then RencTrouvée = True: Exit Function
With JoueursManche(M)
   If .Count = 2 Then
      J1 = .Aléat(1): A1 = .Aléat(2)
      If Not (DéjàRenc(XTria(J1, A1)) Or DéjàTêtÀTête(J1) Or DéjàTêtÀTête(A1)) Then
         DéjàRenc(XTria(J1, A1)) = True
         DéjàTêtÀTête(J1) = True: DéjàTêtÀTête(A1) = True
         RencTrouvée = RencTrouvée(M, L + 1) ' C'est en effet une fonction récursive.
         If RencTrouvée Then
            Tirage(M, L, 2) = J1: Tirage(M, L, 3) = A1
         Else
            DéjàRenc(XTria(J1, A1)) = False: DéjàTêtÀTête(J1) = False: DéjàTêtÀTête(A1) = False: End If: End If
      Exit Function: End If
   J1 = .Aléat(1): .Supprimer J1
   Do: PosJ2 = PosJ2 + 1: J2 = .Aléat(PosJ2)
      If J2 = 0 Then Exit Do
      If Not DéjàPart(XTria(J1, J2)) Then
         DéjàPart(XTria(J1, J2)) = True
         .Supprimer J2
         Do: PosA1 = PosA1 + 1: A1 = .Aléat(PosA1)
            If A1 = 0 Then Exit Do
            If Not (DéjàRenc(XTria(J1, A1)) Or DéjàRenc(XTria(J2, A1))) Then
               DéjàRenc(XTria(J1, A1)) = True: DéjàRenc(XTria(J2, A1)) = True
               .Supprimer A1
               Do: PosA2 = PosA2 + 1: A2 = .Aléat(PosA2)
                  If A2 = 0 Then Exit Do
                  If Not (DéjàRenc(XTria(J1, A2)) Or DéjàRenc(XTria(J2, A2)) Or DéjàPart(XTria(A1, A2))) Then
                     DéjàRenc(XTria(J1, A2)) = True: DéjàRenc(XTria(J2, A2)) = True: DéjàPart(XTria(A1, A2)) = True
                     .Supprimer A2
                     RencTrouvée = RencTrouvée(M, L + 1) ' C'est en effet une fonction récursive.
                     If RencTrouvée Then
                        Tirage(M, L, 1) = J1: Tirage(M, L, 2) = J2
                        Tirage(M, L, 3) = A1: Tirage(M, L, 4) = A2
                        Exit Function: End If
                     .Remettre A2, PosA2
                     DéjàRenc(XTria(J1, A2)) = False: DéjàRenc(XTria(J2, A2)) = False: DéjàPart(XTria(A1, A2)) = False
                     End If: Loop: PosA2 = 0
               .Remettre A1, PosA1
               DéjàRenc(XTria(J1, A1)) = False: DéjàRenc(XTria(J2, A1)) = False
               End If: Loop: PosA1 = 0
         .Remettre J2, PosJ2
         DéjàPart(XTria(J1, J2)) = False
         End If: Loop
   .Remettre J1, 1: End With
End Function
 
Dernière édition:

JBARBE

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

oui ! tu a raison, c'est un essai a l'ouverture du Tableau pour remercier les pro d'Excel-Donwload pour leur aimable gentillesse a la participation de la création des macros, mais il y a eu une erreur , milles excuses.
Sur la photos il y a les joueurs donc celui qui vous a donné du travail (le 3eme de gauche).
Je colle tout de suite le Paquet afin de tester la macro
pour supprimer les " ERREUR - #N/A "
=SI(C16=0;"";RECHERCHEV(C16;'Tableau Tournante'!$A$6:$B$168;2))
et la recherche cellules vides peut se réaliser.
Cordialement Joan

La cellule C16 n'a jamais de 0 mais est vide, il convient de modifier la formule ainsi ( et sur toutes les autres) afin de ne pas avoir d'erreurs ultérieurement :

=SI(ESTNA(RECHERCHEV(C16;'Tableau Tournante'!$A$6:$B$168;2;0));"";RECHERCHEV(C16;'Tableau Tournante'!$A$6:$B$168;2;0))

bonne soirée !
 

Dranreb

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

Bonjour.
Rappel: Il n'y a plus de formule dans ma solution. La feuille Impression est directement produite par la procédure Tirage22. D'ailleurs c'est à se demander si l'autre tableau produit sert encore à quelque chose ?
 

JOAN66

XLDnaute Junior
Re : Tirage au sort aléatoire pour la pétanque

Bonjour Messieurs voici le tableau final de mon projet "Tournante Pétanque " qui sans votre gentillesse et vos compétences je n’aurais pas put réalisé ce tableau avec toutes ces macros incompréhensible pour moi .
Voici donc sont fonctionnement :
rentrer les noms en Majuscules , les cellules sont bloqué a 10 caractères. ( en Maj avec une macro ralenti la vitesse d'exécution, donc abandonné !)
En cellules B8 début du tirage 3 tours
- 10 participants 4 tours, jusqu'a 162 joueurs
Une fois les noms effectués cliquer sur le bouton "TIRAGE" et ensuite si le tirage convient "Impression" (Impression de la feuille des participants pour l'affichage)
Après chaque partie gagnée mettre une " X " en face des joueurs dans T 1 ou T 2 -T 3 et T 4
la colonne "L 6 " sert a valider le payement des parties gagnées ( Visuel)
le bouton " Fin du concours " Impression du tableau " afin d'avoir un support pour archivage
La colonne C6 ne sert pas ( pour l'instant)
Le bouton "Effacer participants " pour recommencer un autre concours.
Le bouton " Fermeture du Tableau " Enregistre et ferme Excel.
La feuille " tournois 1 contre 1 " si on veux faire des têtes à têtes , il suffit de prendre les n° a la mains (la liste de noms toujours " Tableau Tournante " , très peux utilisé au club voir jamais .

pour voir vos macros password " denis"
Millesssss Mercisssss
A bientôt pour d'autres projet sur le site Excel-Downloads.
voici le lien pour télécharger le Fichier Excel : Document Cjoint
 

Dranreb

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

Bonjour.
Pourquoi avez vous préféré mettre des formules (plus compliquées que nécessaires d'ailleurs) dans la feuille impression plutôt que de la faire produire directement par la procédure MTirage22 ?
 

JOAN66

XLDnaute Junior
Re : Tirage au sort aléatoire pour la pétanque

Bonsoir! Dranreb, oui ,il y a bien des formules ou macros a travailler encore , mais le tableau fonctionne , Yess!.
Désolé, mais la procédure MTirage 22 est trop compliqué pour moi et je n'ai pas les compétences pour la la comprendre alors je l'ai adapté à ma sauce pour faire fonctionner la feuille "Impression " , bref! pas doué en Excel et encore moins avec les Macros, comme vous avez pu vous en rendre compte .
Cordialement Joan
Encore merci de toutes les aides que j'ai trouvé sur le site Excel-Downloads
 

Dranreb

XLDnaute Barbatruc
Re : Tirage au sort aléatoire pour la pétanque

Au #143 j'ai pourtant mis la totalité du code du module, il suffisait de tout remplacer.
Si tu n'y comprend rien c'est que ça ne t'intéresse pas de comprendre.
Je ne parle pas du processus: c'est juste une ligne qui l'engage dans la Tirage22, ça je veux bien que ce soit un peut trop pointu, mais pas tout ce qu'il y a avant ni après !
Pour info j'ai maintenant chez moi la Sub Tirage33 en plus pour les triplettes. Et aussi à chaque manche en fin une rencontre à 4 ou 2 si effectif non multiple de 6.
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 754
Membres
101 812
dernier inscrit
trufu