modification pour tirage au sort 5 fois différents Fermé

Question

Bonjour, 
j'ai un code qui me permets de tirer au sort des données
 Mais j'aimerais que ce code fasse 5 tirage et que aucune données
 soit les mêmes au fur à mesure des tirages 
 (de façon 100% fiable)
 Alors en resume
 a chaque partie chaque "equipier" joue avec un autre equipier contre un autre duo d'equipier
 Donc il faut tirer ces equipiers au sort mais a chaque aucun de ces equipiers ne doivent se retrouver dans les matchs d'après 
les équipiers doivent aterrirent dans les colonnes C des tour 1-5
 juste une précision les coéquipiers de peuvent pas joué 2 fois un contre l'autre et ni 2 fois ensemble 
 Merci d'avance



 Sub tirage_automatique()
 ReDim t(0)
 For Each cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
 If cel.Value <> "" Then
 t(UBound(t)) = cel.Value
 ReDim Preserve t(UBound(t) + 1)
 End If
 Next
 ReDim Preserve t(UBound(t) - 1)
 Set dico = CreateObject("scripting.dictionary")
 Randomize
 While dico.Count < UBound(t) + 1
 x = Int((UBound(t) + 1) * Rnd)
 dico(x) = t(x)
 Wend
 Range("C2").Resize(UBound(t) + 1) = Application.Transpose(dico.items)
 End Sub

michel_m · Answer

Bonjour
dim T()
T=Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).value 'renvoie un tableau de base 1
randomize
While dico.Count < 6  'tu demandes 5 tirages !
   x = Int((UBound(t)) * Rnd)+1
   ref=T(x)
   if not dico.exists(ref) then dico.add ref,""
Wend

Range("C2").Resize(dico.count,1) = Application.Transpose(dico.keys)  
 
 Michel

rocornet · Answer

Bonjour,
dès que j'exécute la macro et la fenêtre me demande: Objet requis
en appuyant sur débogage ça me montre qu'il y a un problème  ici:
While dico.Count < 6 'tu demandes 5 tirages !
Que dois-je faire?
Merci d'avance

michel_m · Answer

Bonjour, 
Désolé, pas mal de trucs à faire cette semaine !

Option ExplicitSub Selectionner_joueurs()Dim Tablo(), Lig As Byte, Ref As String, Dico As Object, Joueurs()Range("C2:C6").ClearContentsSet Dico = CreateObject("scripting.dictionary")Tablo = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value 'renvoie un tableau de base 1RandomizeWhile Dico.Count < 5 'tu demandes 5 tirages !     Lig = Int((UBound(Tablo)) * Rnd) + 1     Ref = Tablo(Lig, 1)     If Not Dico.exists(Ref) Then Dico.Add Ref, ""WendJoueurs = Dico.keysRange("C2").Resize(Dico.Count, 1) = Application.Transpose(Joueurs)End Sub
 Michel

Modification pour tirage au sort 5 fois différents

3 réponses

Discussions similaires