Horaire hebdomadaire pour 12 joueurs

Je suis à la recherche d,un outil pour bâtir un horaire hebdomadaire de 3 équipes de quatre joueurs. À chaque semaine chacun des joueurs doit jouer avec un joueur différent afin qu'ultimement chaque joueur jouera avec chacun des joueurs.

Exemple :

Semaine 1 :

Groupe 1 : joueur 1, 2, 3 et 4 jouent ensemble

Groupe 2 : joueur 5, 6, 7 et 8 jouent ensemble

Groupe 3 : joueur 9, 10, 11 et 12 jouent ensemble

Semaine 2 :

Groupe 1 : joueur 1 joue avec ?

Groupe 2 : ?

Groupe 3 : ?

Et ainsi de suite pour 20 semaines....

Merci

Bonjour,

à tester,

Sub LesEquipes()
'activer la référence "Microsoft Scripting Runtime"
Dim Dico As New Scripting.Dictionary
Dim i As Integer, j As Integer, y As Integer, x1 As Integer, x2 As Integer
Dim eq As String, NbJoueur As Integer, k
NbJoueur = 12

For i = 1 To NbJoueur
    For j = 1 To 12
        If i <> j Then
            x1 = j + 1
            x2 = j + 2

            If x1 <> i And x2 <> i And x2 <= NbJoueur Then

               k = Array(i, j, x1, x2)
               For y = LBound(k) To UBound(k)
                eq = eq & "  " & Application.Small(k, y + 1)
               Next y

               If Not Dico.Exists(eq) Then Dico.Add eq, 1
            End If

        End If
        eq = ""
    Next j
Next i
Range("A1").Resize(UBound(Dico.Keys), 1) = Application.Transpose(Dico.Keys)
End Sub
Rechercher des sujets similaires à "horaire hebdomadaire joueurs"