Tirage au sort avec contraintes

[Rénato]

Bonjour,

Je souhaite savoir si je peux automatiser le tirage au sort suivant sur EXCEL ?


J'ai 40 joueurs de longue (Jeu de boules lyonnaise) qui doivent concourir par équipes de 3 et faire 3 parties.
il ne doivent au cours de ces 3 parties ni tomber 2 fois avec un même partenaire, ni tomber 2 fois contre un même adversaire.

Quelqu'un d'entre vous a-t-il une idée ?

Merci pour votre diligence

 

[Myta]

salut Rénato

Oufs soit patience par contre


Sub Tournoi()

Range("C6:H125").ClearContents

Dim A(6) As Byte
Dim Total(6) As Byte
Dim I As Byte
Dim K As Byte
Dim Ligne As Byte
Dim Deplacement As Byte
Dim Cellule As Range
Dim Test As Byte

For K = 1 To 40

Application.ScreenUpdating = True
Cells(1, 1) = 40 - K
Application.ScreenUpdating = False

'Générer six joueurs sans doublons

Reprise:

Cells(3, 3) = Int(Rnd() * 40 + 1)
2:
Cells(3, 4) = Int(Rnd() * 40 + 1)
If Cells(3, 4) = Cells(3, 3) Then GoTo 2
3:
Cells(3, 5) = Int(Rnd() * 40 + 1)
If Cells(3, 5) = Cells(3, 3) Or Cells(3, 5) = Cells(3, 4) Then GoTo 3
4:
Cells(3, 6) = Int(Rnd() * 40 + 1)
If Cells(3, 6) = Cells(3, 3) Or Cells(3, 6) = Cells(3, 4) Or Cells(3, 6) = Cells(3, 5) Then GoTo 4
5:
Cells(3, 7) = Int(Rnd() * 40 + 1)
If Cells(3, 7) = Cells(3, 3) Or Cells(3, 7) = Cells(3, 4) Or Cells(3, 7) = Cells(3, 5) Or Cells(3, 7) = Cells(3, 6) Then GoTo 5
6:
Cells(3, 8) = Int(Rnd() * 40 + 1)
If Cells(3, 8) = Cells(3, 3) Or Cells(3, 8) = Cells(3, 4) Or Cells(3, 8) = Cells(3, 5) Or Cells(3, 8) = Cells(3, 6) Or Cells(3, 8) = Cells(3, 7) Then GoTo 6

'Lire le tableau avec la génération

For I = 1 To 6
A(I) = Cells(3, 2 + I)
Total(I) = 0
Next I

'Vérifier si deja plein

For I = 1 To 6
Ligne = A(1) * 3 + 3
If Cells(Ligne, 3) <> "" And Cells(Ligne + 1, 3) <> "" And Cells(Ligne + 2, 3) <> "" Then GoTo Reprise
Next I

'Vérifier pas plus de 3 fois

For Each Cellule In Range("C6:H125")

If Cellule.Value = A(1) Then Total(1) = Total(1) + 1
If Cellule.Value = A(2) Then Total(2) = Total(2) + 1
If Cellule.Value = A(3) Then Total(3) = Total(3) + 1
If Cellule.Value = A(4) Then Total(4) = Total(4) + 1
If Cellule.Value = A(5) Then Total(5) = Total(5) + 1
If Cellule.Value = A(6) Then Total(6) = Total(6) + 1

For Test = 1 To 6
If Total(Test) > 18 Then GoTo Reprise
Next Test

Next Cellule

'On récupère la génération

For I = 1 To 6

Deplacement = 0

Suite:

Ligne = A(I) * 3 + 3 + Deplacement

If Deplacement > 2 Then GoTo Fin

If Cells(Ligne, 3) = "" Then
Cells(Ligne, 3) = A(1)
Cells(Ligne, 4) = A(2)
Cells(Ligne, 5) = A(3)
Cells(Ligne, 6) = A(4)
Cells(Ligne, 7) = A(5)
Cells(Ligne, 8) = A(6)
Else
Deplacement = Deplacement + 1
GoTo Suite
End If

Fin:

Next I

Next K

Application.ScreenUpdating = True

End Sub

Reste a eliminer les doublons et sortir la liste des parties (version 1.0)

Mytå

 

[Rénato]

Bonjour Myta,


Désolé de t'avoir fait travailler un jour de fête, en tous cas je te remercie vivement pour ta réactivité et ton efficacité.
Je vais tester tes lignes de code et te tiendrai au courant sur un prochain topic des résultats obtenus.

Très cordialement

 

[Myta]

Re Bonsoir le Forum et Rénato

Il y avait un bogue avec la Macro

il est corriger regarde ton cadeau de Noel en piece jointe ))

J'ai pas gerer l'affichage ecran pour voir le programme travailler

Et faut lui laisser le temps de trouver les bonnes combinaisons (Ca peut-etre long)

Mytå (Qui fait le Pere_Noel)

 

[Rénato]

Bonjour Père Noel Myta

Très aimable à toi d'avoir creusé encore un peu plus mon problème.
je viens de tester le tableur, c'est presque parfait, néanmoins je t'ai mis en évidence sur le fichier joint en retour "2 anomalies" sur un même tirage.

Merci encore pour ta disponibilité et ta vonlonté de partage des connaissances, très appréciée par un néophytes en VBA comme moi.

 

[Ti]

Bon, j'ai oublié cette fichue grippe qui me cloue au lit depuis le début de la semaine en m'amusant sur ce problème.
En fait, j'avais déjà géré un tournoi de pétanque par doublettes, mais jamais des triplettes et jamais avec la double contrainte : 1 fois 1 partenaire, 1 fois 1 adversaire max.

La macro que j'ai pondue semble fonctionner correctement, mais j'avoue que je n'en suis pas très content, elle aurait pu être simplifiée et - comme je navigue encore largement dans le brouillard - je n'en maîtrise pas parfaitement le fonctionnement. En particulier, elle pédale quelquefois alors qu'il reste encore 7 ou 8 joueurs à placer. J'ai mis un test pour gérer ça, mais je ne sais pas dire s'il y aura des cas où ça pédalera avec 9 joueurs ou plus.
En tout cas, son fonctionnement est plutôt rapide, c'est ce qui compte. Et au final, le tableau est trié et mis en forme pour l'impression (il faudra voir si Excel 2000 accepte le tri tel quel).

Je laisse éventuellement aux accrocs des formules le soin de parfaire la feuille tirage en supprimant ma fonction OfsLigne et en la remplaçant par une formule Excel plus rapide.

 

[Monique]

Bonjour,

Une formule (matricielle) pour remplacer la fonction OfsLigne.
=PETITE.VALEUR(SI(Jeu=LIGNES(C$6:C6);LIGNE(Jeu));COLONNES($B6:C6)/2)-3
à valider par ctrl, maj et entrée.

 

[Ti]

Merci Monique, comme ça c'est parfait, maintenant c'est à Rénato de nous dire si ça lui convient.

 

[Ricket (père de Rénato)]

Merci à TI et Monique pour vos précieux conseils, effectivement ça marche très bien.
derniere petite question à TI, je souhaite paramétrer ce même programme pour 30 équipes (et non plus 40), j'ai essayé de changer "des variables" dans le script....mais je collectionne les messages d'erreurs
Si ceci ne nécessite pas trop de recherches, peux-tu me dire ce que je dois changer ?

Merci encore

 

[Ti]

Voilà une nouvelle version qui permet d'effectuer des tirages entre 16 et 84 joueurs. (16 parce qu'avec moins, ça rame indéfiniment, 84 à cause de la technique que j'utilise pour générer les nombres aléatoires).
Comme il fallait s'adapter à ces divers changements, j'ai dû modifier le contrôle des erreurs pour l'adapter à cette plage de valeurs assez large. La recherche s'effectue donc à peine moins vite maintenant, mais ça reste très supportable.
Attention à ne pas effacer par mégarde les formules dans les cellules qui "perdent" leur mise en forme lorsqu'elles sont vides (feuilles Equipes et Répartition)

 

[Ricket (père de Rénato)]

Salut TI,

Tu es allé au-delà de mes espérances, en me proposant une variable sur le nombre de joueurs.
Nous venons de tester le programme qui nous donne entière satisfaction, il est même applicable dans les années à venir en fonction de l'accroissement de notre nombre de licenciés.

Quand je vois le nombre d'heures que nous avons consacré à dessiner des arbres afin d'obtenir un résultat imparfait mais que nous avons jusqu'ici utilisés faute de mieux, nous sommes epoustouflés par le programme que tu nous as réalisé aussi vite, et de plus un dimanche.

Nous allons épater les copains du club, mais nous aurons la modestie d'avouer que nous avons n'avons pas été à l'origine de cette réussite.

Je tiens à vous remercier chaleureusement MYTA, T.I. ainsi que Monique pour votre efficacité, amabilité et réactivité.

Je ne manquerai pas en contre partie d'apporter ma contribution aux questions de premier niveau qui seront posées sur votre forum.

Cordialement

Rénato et Ricket

 

[Ricket (père de Rénato)]

Désolé TI mais j’ai une dernière sollicitation, pour les parties qui comprennent 14,24,30,36 ou 42 joueurs, il faudrait que 4 parties (voir 3) puissent se dérouler en même temps sur le terrain sachant que toutes les conditions initiales sont maintenues (jeux en triplette, chaque joueur ne doit pas jouer plus d’une fois avec le même partenaire ni plus d’une fois contre le même adversaire et chacun fera 3 parties) .
Est-ce possible ?
Illustration :
Certains tournois en hiver doivent se dérouler sur une seule journée
J’ai 32 joueurs, donc 16 parties à disputer notre boulodrome comporte 4 jeux, afin d’optimiser les terrains, j’organise 2 séances de 4 jeux le matin puis 2 autres séances de 4 jeux l’après midi. Les parties durant 2 heures au maximum.

Ce n’est peut être qu’un question d’ordre de tirage, mais mes compétences sont bien trop limitées pour approfondir la recherche.
La cerise sur le gâteau ça serait qu’en plus les joueurs aient tous joués au minimum une partie le matin…..ça c’est pour éviter les railleries des pénibles qu’on a fait lever et qui finalement ne seront appelés à jouer que l’A.M.

Si cette dernière recherche nécessite un trop gros investissement, laisse tomber .

Cordialement