[XL-2000] Organiser un tournoi d'echec en VBA [Résolu]

[evx136]

Bonjour,
je dois organiser un tournoi d'echec ou tous les joueur doivent se rencontrer.
Quand le nombre de joueurs est Pair j'ai trouvé un code.
Là ou ça se complique c'est quand le nombre de joueur est Impair, par exemple 9 joueurs puisque un joueur est libre à chaque rotation.
Je joins un fichier avec le code des nombres pair de joueurs.
Merci pour vos idées pour les nombre impairs

[Daniel.C]

Bonjour,

Il me semble que ce n'est pas une question Excel, mais un problème d'organisation.
Si tu donnes à chaque joueur un numéro, de 1 à 9, les joueurs 1 à 8 font une première partie; au deuxième tour, le joueur 9 et les joueurs 1 à 7 jouent le second tour. Au bout de 9 tours, on compte les points.
L'inconvénient est qu'il n'y a pas d'élimination directe et que 9 parties, c'est sans doute très long. Tu peux peut-être faire ces premiers tours en partie flash ppour sélectionner les joueurs (8 ou 4 ou 2 s'affrontant en élimination directe.)
Sinon, expose la disposition de tes données puisque ton classeur a été supprimé.

[evx136]

Bonjour et merci de me lire.
tous les joueurs se rencontrent mais dans un temps délimité. et ils doivent tous se rencontrer.

Ce n'est pas un problème d'organisation mais plutôt de de construction du tableaux des rencontres

[Daniel.C]

Avec le nom des joueurs en A1:A9, essaie :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
    Dim c As Range, Ligne As Long, Plage As Range, Tabl
    Ligne = 1
    Range([B1], Cells(Rows.Count, 2).End(xlUp)).Resize(, 3).ClearContents
    For i = 0 To 90 Step 9
        [A1:A9].Copy [A10].Offset(i)
    Next i
    i = 0
    For i = 0 To 80 Step 8
        [A1:A8].Copy Cells(Ligne, 2).Resize(8)
        i = i + 1
        Ligne = Ligne + 8
    Next i
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If Cells(i, 1) = Cells(i, 2) Then Rows(i).Delete
    Next i
End Sub

[evx136]

Bonjour Daniel
Ton code m'a aidé, sauf qu'il ne me disait pas le joueur qui est libre et ce à chaque série.

J'ai donc fait comme suit
En partant du principe qu'il y a 15 joueurs, dans la colonne 5 je les numerotent, ce qui fait donc 14 rencontres par joueur.
Sur la ligne 2 le numero des rencontres de 1 à 14
voilà le code et j'accepte la critique voire les améliorations.

Code :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Dim maligne As Integer, maCol As Integer, nb_participant As Integer, nb_rencontre As Integer
Sub JOUEUR_15()
nb_participant = 15
Sheets("Feuil1").Activate
' **** determiner la ligne de fin
For nb_ligne = 3 To 100
   If Sheets("Feuil1").Cells(nb_ligne, 5).Value = nb_participant Then
        maligne = nb_ligne
        Exit For
   End If
Next nb_ligne
'*************determiner la colonne de fin
nb_rencontre = (nb_participant - 1) / 2
For nb_col = 3 To 100
   If Sheets("Feuil1").Cells(2, nb_col).Value = nb_rencontre Then
        maCol = nb_col
        Exit For
   End If
Next nb_col
 For lig = 3 To maligne Step 2
   ma_Valeur = Sheets("Feuil1").Cells(lig, 5).Value
   For col = 6 To maCol
      ma_Valeur = ma_Valeur + 1
      If ma_Valeur > nb_participant Then ma_Valeur = ma_Valeur - nb_participant
        Sheets("Feuil1").Cells(lig, col).Value = ma_Valeur
 
 
    Next col
 
    For col_inverse = maCol To 6 Step -1
       ma_Valeur = ma_Valeur + 1
       If ma_Valeur > nb_participant Then ma_Valeur = ma_Valeur - nb_participant
       Sheets("Feuil1").Cells(lig + 1, col_inverse).Value = ma_Valeur
    Next col_inverse
 
 Next lig
 Call conca
End Sub
Sub conca()
'Dim num_Participant As Integer
 ligne_fin = nb_participant + 2
 Sheets("Feuil1").Activate
 For lig = 3 To maligne Step 2
  Sheets("Feuil1").Activate
  num_Participant = Sheets("Feuil1").Cells(lig, 5).Value
     For col = 6 To maCol
        Param_1 = Sheets("Feuil1").Cells(lig, col).Value
         Param_2 = Sheets("Feuil1").Cells(lig + 1, col).Value
                 Paire = Param_1 & "_" & Param_2
      Sheets("Feuil2").Activate
              For x = 2 To ligne_fin
                If Sheets("Feuil2").Cells(x, 2).Value = num_Participant Then
                   For y = 3 To 100
                      If Sheets("Feuil2").Cells(1, y).Value <= nb_rencontre Then
                          If Sheets("Feuil2").Cells(x, y).Value = "" Then
                             Sheets("Feuil2").Cells(x, y).Value = Paire
                             Exit For
                          End If
                      End If
                   Next
                   Exit For
                End If
             Next x
              Sheets("Feuil1").Activate
   Next col
   Sheets("Feuil1").Activate
 Next lig
 
    Sheets("Feuil2").Activate ' RESULTAT
End Sub

J'ai adapté ce code avec un userForm et un ComboBox qui donne le choix de participants

Encore merci
Cordialement