Microsoft 365 calendrier compétition

piskely

XLDnaute Junior
Bonjour à tous,

Je sollicite votre concours pour fixer mon problème.
En fait, je veux créer une macro pour établir un calendrier de rencontre.

Cette macro a pour objectif de créer un calendrier de rencontre où une équipe doit rencontrer toutes les autres sauf elle-même.
Cela veut dire que tous les matchs pouvant être effectués en même temps seront regroupés.

Exemple : Pour 4 équipes Equipe1,Equipe2,Equipe3,Equipe4, un tirage possible est :
Rencontres 1 : Equipe1 vs Equipe2 et Equipe3 vs Equipe4
Rencontres 2 : Equipe1 vs Equipe4 et Equipe2 vs Equipe3
Rencontres 3 : Equipe1 vs Equipe3 et Equipe4 vs Equipe2...

j'aai uncode erreur d'exécution "9".
merci d'avance pour lasolution.


VB:
Sub GenererCalendrier()
    
    ' Déclaration des variables
    Dim Equipes As Variant
    Dim nbEquipes As Integer
    Dim nbRencontres As Integer
    Dim Resultats() As String
    Dim i As Integer, j As Integer, k As Integer
    Dim temp As Variant
    
    ' Déclaration des constantes
    Const EQUIPES_RANGE As String = "A1:A6"
    Const CALENDRIER_COL_DEBUT As Integer = 2
    Const CALENDRIER_COL_FIN As Integer = 4
    
    ' Récupération des équipes dans la plage A1:A8
    Equipes = Range(EQUIPES_RANGE).Value
    
    ' Validation du nombre d'équipes
    If UBound(Equipes, 1) Mod 2 <> 0 Then
        MsgBox "Le nombre d'équipes doit être pair."
        Exit Sub
    End If
    
    ' Détermination du nombre d'équipes et de rencontres
    nbEquipes = UBound(Equipes, 1)
    nbRencontres = nbEquipes - 1
    
    ' Mélange des équipes
    For i = 1 To nbEquipes
        j = Int(Rnd() * nbEquipes) + 1
        temp = Equipes(i, 1)
        Equipes(i, 1) = Equipes(j, 1)
        Equipes(j, 1) = temp
    Next i
    
    ' Dimensionnement du tableau de résultats
    ReDim Resultats(1 To nbRencontres, 1 To nbEquipes)
    
    ' Génération du calendrier
    k = 1 ' Numéro de la rencontre
    For i = 1 To nbEquipes - 1
        For j = i + 1 To nbEquipes
            Resultats(k, 1) = "Rencontre " & k
            Resultats(k, i + 1) = Equipes(i, 1) & " vs. " & Equipes(j, 1)
            Resultats(k, j + 1) = Equipes(j, 1) & " vs. " & Equipes(i, 1)
            k = k + 1
        Next j
    Next i
    
    ' Affichage du calendrier dans les colonnes B à D
    Range(Cells(1, CALENDRIER_COL_DEBUT), Cells(nbRencontres, CALENDRIER_COL_FIN)).Value = Resultats
    
End Sub
 

Pièces jointes

  • Programme.xlsm
    20.6 KB · Affichages: 12

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T