3 tirages aléatoires de binômes sans doublon

bonjour,

Je souhaiterais obtenir de l’aide sur la problématique ci-dessous.

A partir d’une liste de 16 joueurs, je dois :

- effectuer un 1er tirage aléatoire pour obtenir 8 équipes de 2 (8 binômes) pour la partie 1

- effectuer un 2eme tirage aléatoire pour 8 nouveaux binômes pour la partie 2

- de même pour une 3 eme partie.

Condition nécessaire : un même binôme ne peut exister 2 fois sur les 3 tirages…

Je sais effectuer les tirages aléatoires mais je bloque sur l’ajout de la condition…

J’espere vraiment que quelqu’un m’enlèvera cette épine du pied. Merci d’avance.

bonjour,

avec VBA, je peux aller jusqu'à 8 tirages (même plus)

Const iNombre = 16

Sub aleatoire()
     Dim dict, a, nmb, r1, r2, r3, i1, i2, s1, s, aRes, iL, iC
     Set dict = CreateObject("scripting.dictionary")
     ReDim aRes(1 To iNombre \ 2, 1 To 8) 'matrice avec

     For irounds = 1 To UBound(aRes, 2)
          iL = 1: iC = irounds
          s = ""
          nmb = iNombre
          a = [column(A1:Z1)]
          Do
               ptr = ptr + 1
               If nmb >= 2 Then
                    r1 = WorksheetFunction.RandBetween(1, nmb)
                    Do
                         r2 = WorksheetFunction.RandBetween(1, nmb)
                    Loop Until r2 <> r1
                    If r1 > r2 Then r3 = r1: r1 = r2: r2 = r3
                    i1 = a(r1): i2 = a(r2)
                    If InStr(1, s, "|" & i1 & "|") + InStr(1, s, "|" & i2 & "|") = 0 Then
                         s1 = IIf(i1 < i2, i1 & "-" & i2, i2 & "-" & i1)
                         i = dict(s1)
                         If i <= 1 Then
                              s = s & "-" & s1 & "-"
                              a(r1) = a(nmb - 1)
                              a(r2) = a(nmb)
                              nmb = nmb - 2
                              dict(s1) = dict(s1) + 1
                              aRes(iL, iC) = "'" & s1
                              iL = iL + 1
                         End If
                    End If
               End If
               DoEvents
          Loop While nmb > 0 And ptr < 1000
     Next

    ActiveSheet.Range("A1:K1").EntireColumn.ClearContents
     Range("A1").Resize(UBound(aRes), UBound(aRes, 2)).Value = aRes
Range("A10") = ptr

     With Cells(1, 10).Resize(dict.Count)
          .Value = Application.Transpose(dict.keys)
          .Offset(, 1).Value = Application.Transpose(dict.items)
     End With
End Sub

Bonjour,

je vous remercie énormément pour votre réponse qui m'apporte plus que j'attends car, en réalité, je dois réaliser 7 tirages et non 3.

Mais malheureusement, lorsque je teste votre fichier, j'obtiens quand même des doublons d''équipes.

Pour être plus clair : dès qu'un binôme existe dans une partie, il ne peut plus exister dans les parties suivantes.

bonjour,

une proposition, basée sur l'élaboration d'un calendrier de rencontres pour un championnat.

re,

j'avais compris la question, un couple pouvait revenir une 2ième fois, pas grave, la ligne "If i <= 1 Then" devient "If i < 1 Then"

re,

même tirage avec de noms

Bonjour,

je vous remercie énormément (BsALv et H2So4) pour vos propositions qui m'avancent beaucoup dans mon travail.

BsAlv : les tirages au sort me donnent quand même des résultats impossibles avec tes 2 fichiers : Un joueur (numéro) ne peut pas ressortir 2 fois dans la même partie comme c'est le cas dans la copie écran ci-dessous (2 fois le joueur 3 dans la partie B ; 3 fois le joueur 9 dans la partie H)

Bonjour,

une proposition farfelue:

normalement ça gère: le fait de ne pas ressortir plusieurs fois le même joueur par partie, le fait de ne pas avoir plusieurs fois le même binôme.

re, j'ai fixé le problème, en math le somme d'une sequence 1,2,3,....,n = n*(n+1)/2 donc supposons 18 joueurs >>> 18*19/2 = 171, c'est ce chiffre dans la ligne 2. Les colonnes avec une somme différente ne sont pas okay (et jaune)

@AuSecours,

Merci beaucoup à vous tous, grâce à vous j’ai obtenu ce que je désirais.

merci,

la méthode à Ausecours est simple et génial, une combinaison rare.

BsAlv a écrit :

merci,

la méthode à Ausecours est simple et génial, une combinaison rare.

Ahah merci, je vais rougir