Effectuer un tirage au sort avec conditions

Bonjour,

Voilà je cherche a effectué la chose suivante :

J'ai 30 personnes issus de 4 clubs différents par exemples.

Je cherche à effectué un tirage au sort et attribué un numéro de 1 a 30 a chaque personnes mais la contrainte c'est qu'il n'y ai pas plus de 2 personnes d'un même club avec un numéro en suivant (ex : poste 1 : Gérard du club de Paris, poste : 2 José du club de Paris, c'est ok mais au poste 3 ce sera obligatoirement quelqu'un d'un autre club)

merci à vous.

Bonjour à tous !

Jon 34, donc c'est un tirage de 8 sur 30 avec comme maximum de 2 par club si je comprends bien ta demande ou combien de postes tirés sur 30 ? Un fichier serait bienvenue aussi...

Bonne journée !

Bonsoir à tous!

Jon 34, vois si cela te convient tu devras adapter à ta guise

bonsoir,

Sub Tirage()
     t = Timer
     Dim Resultat(1 To 8, 1 To 3)
     With Sheets("Feuil1")
          a = .Range("A1").CurrentRegion.Value     'lire le contenu
          aleatoire = Evaluate("=column(offset(a1,,,," & UBound(a) & "))")     'série ascendante 1,2,3,...,n
          For i = UBound(a) To 2 Step -1     'boucle avec chaque fois une possibilité en moins
               r = WorksheetFunction.RandBetween(2, i)     'random valeur entre 2 et i
               nr = aleatoire(r)     'numéro dans a
               fl = Filter(Application.Transpose(Application.Index(Resultat, 0, 3)), "|" & a(nr, 3) & "|", 1, vbTextCompare)     'compte le nombre du même club
               If UBound(fl) < 1 Then     '(avec base 0 !!!) si c'est inférieur à 1, il n'y a pas encore 2 de ce club
                    ptr = ptr + 1     'pointer aumenter
                    For j = 1 To 3: Resultat(ptr, j) = IIf(j = 3, "|", "") & a(nr, j) & IIf(j = 3, "|", ""): Next
               End If
               aleatoire(r) = aleatoire(i)     'swap valeurs
          Next

          With .Range("N1").Resize(UBound(Resultat), UBound(Resultat, 2))     'plage pour coller les resultats
               .Value = Resultat
               .Replace "|", ""     'effacer les "pipes"
          End With
     End With
     MsgBox Format(Timer - t, "0.00")
End Sub

Bonjour nordik

Je vous envoie un exemple du tableur mais c'est ce que vous avez fait seulement il faut que les 30 personnes se voient attribuer un numéro de 1 a 30 sans doublons.

et que personne d'un même club ne soit tiré au sort l'une à côté de l'autre ou au maximum 2.

merci

Merci d'avance pour votre aide

bonjour,

Bonjour à tous!

Jon34, BsAlv, une autre approche pas aussi bien fait dans le code que notre ami BsAlv mais fonctionnel également

MERCI BEAUCOUP