Tirage au sort aléatoire pour la pétanque

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.
 

JOAN66

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

re bonsoir , oui tu as raison j'ai une petite tête et hélas je ne comprends tout. Pour le tirage " Sub Tirage33 " je suis intéressé par cette macro .
Merci d'avance
Cordialement Joan
 

Dranreb

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

Mais oui, mais qu'est ce que tu va bien pouvoir en faire si tu refuses de t'intéresser à la programmation ?
Ça me donne une idée tiens, je vais séparer les processus de tirage des fonctionnalités de mise en page. Je vais peut être mettre ces dernières dans les modules des feuilles de mon classeur de démo ListeAléat. Et un module central avec une procédure Tirage unique mais paramétrée et des commentaires explicatifs d'utilisation.
 
Dernière édition:

marco29

XLDnaute Nouveau
toujours pierre jean j ai un soucis et je ne trouve pas mon bonheur sur le forum.pour mon club, je souhaiterais faire un tirage
d équipe sur 3 tours . j ai donc 4 clubs, c est équipe ne doivent pas se rencontrer un 2 fois et les equipe d une meme club de doivent pas non plus se rencontrer merci pour votre aide codialement
 

Discussions similaires


Haut Bas