Microsoft 365 calendrier compétition

[piskely]

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.

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

 

[TooFatBoy]

Ca se rapproche.

Toutefois, il y a des doublons.
Par exemple l'équipe 4 rencontre 2 fois l'équipe 5.

 

[ARMAEL]

Ca se rapproche.

Toutefois, il y a des doublons.
Par exemple l'équipe 4 rencontre 2 fois l'équipe 5.

ALORS T'a pas eu idee comment je peux faire

 

[TooFatBoy]

ALORS T'a pas eu idee comment je peux faire

LOL ben non !

 

[ARMAEL]

LOL ben non !

ok

 

[ARMAEL]

Voii le code modifié

 

[piskely]

Voci le fichier

C'est super ARMEL
je ne te remercierai pas assez! C'est une très bonne base je que j'aurai du plaisir à essayer d'améliorer.
Merci à tous pour le temps consacré à ma solicitation.

 

[ARMAEL]

C'est super ARMEL
je ne te remercierai pas assez! C'est une très bonne base je que j'aurai du plaisir à essayer d'améliorer.
Merci à tous pour le temps consacré à ma solicitation.

Faudrait juste que tu dises que le probleme est resolu soit par la fleche sur la personne qui t'a aidé .

 

[ARMAEL]

Faudrait juste que tu dises que le probleme est resolu soit par la fleche sur la personne qui t'a aidé .

pour que la communauté retraite ton probleme une deuxieme fois alors qu'il est resolu et que les autres membres puises traiter les autres problemes

 

[ARMAEL]

pour que la communauté retraite ton probleme une deuxieme fois alors qu'il est resolu et que les autres membres puises traiter les autres problemes

pour que la communauté ne retraite pas ton probleme une deuxieme fois alors qu'il est resolu et que les autres membres puises traiter les autres problemes