Creation equipe de 2 aleatoirement avec toute les combinaiso

Bonjour

Je fais parti d'une petite association de Badminton et nous organisons des petits tournois.

Aujourd’hui la création des équipe est faite sur Excel à la main et c'est long et cela deviens presque impossible au delà de dix joueurs.

Je souhaiterais donc à partir d'une liste créer des équipes de 2 qui seront reparti sur 3 terrains.

Nous avons besoins d'avoir toute les combinaisons possible.

Le nombre de joueur évolue sans cesse et nous arrivons a parfois 20 joueurs.

Est il possible avec Excel et une macro de générer cette liste de binôme sur deux colonnes et de les répartir sur chaque des trois terrains que nous avons de disponible.

D'avance merci

Cordialement

bonsoir

Vous devez envoyer un fichier exemple qui représente la structure et les liste des joueurs avec des explications détaillés (exemples) et je pense que vous trouviez votre besoin ici sur ce forum

Bonjour

Ci-joint le fichier que nous utilisons..

J'ai regardé sur tous les forums, rien ne correspond à ma demande.

Av

Bonjour,

Personne pour m'aider?

A tester

Bonjour,

voici une proposition, j'ai compris qu'il fallait générer toutes les rencontres de chaque équipe et attribuer un des 3 terrains à chacune de ces rencontres, ce qui est différent de la création des toutes les équipes de 2 joueurs sur base d'une liste de joueurs.

Sub aargh()
    Dim eq(), n()
    With Worksheets("EQUIPES")
        ne = .Cells(Rows.Count, 1).End(xlUp).Row
        ReDim eq(ne + 1)
        ReDim n(ne + 1)
        For i = 1 To ne - 9
            eq(i) = i
            n(i) = .Cells(i + 9, 1)
        Next i
        If (ne - 9) Mod 2 = 1 Then
            eq(i) = i
            n(i) = "bye"
        End If
    End With
    ne = i
    With Sheets("distribution équipes")
        nl = .Cells(Rows.Count, 3).End(xlUp).Row
        .Range("C3:F" & nl).ClearContents
        k = 2
        For j = 1 To ne - 1
            For i = 1 To ne / 2
                If n(eq(i)) <> "bye" And n(eq(i + (ne / 2))) <> "bye" Then
                    k = k + 1
                    If (k Mod 3) = 0 And k > 5 Then
                        .Range("A3:A5").Copy .Range("A" & k)
                        .Range("B" & k & ":F" & k + 2).ClearContents
                        .Range("B3:F5").Copy .Range("B" & k)
                        .Range("C" & k & ":F" & k + 2).ClearContents
                        .Cells(k, 1) = .Cells(k - 3, 1) + 1
                    End If
                    .Cells(k, 3) = n(eq(i))
                    .Cells(k, 6) = n(eq(i + (ne / 2)))
                End If
            Next i
            a = eq(2)
            For i = 2 To (ne / 2) - 1
                eq(i) = eq(i + 1)
            Next i
            eq(ne / 2) = eq(ne)
            For i = ne To (ne / 2) + 2 Step -1
            eq(i) = eq(i - 1)
            Next i
            eq(ne / 2 + 1) = a
        Next j
    End With
End Sub

J'ai corrigé un bug dans la génération des rencontres.