Modification pour tirage au sort 5 fois différents

rocornet -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention - 21 nov. 2013 à 08:15

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

A voir également:

Modification pour tirage au sort 5 fois différents
Suivi de modification word - Guide
Logiciel gratuit modification pdf - Guide
Aucun son ne sort de mon pc - Guide
Je suis une chose que les garçons utilisent 2 fois par jour et les filles une fois dans leur vie - Forum Loisirs / Divertissements
Sirène pompiers 5 fois signification ✓ - Forum Loisirs / Divertissements

3 réponses

Réponse 1 / 3

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

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

Réponse 2 / 3

rocornet

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

Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention 1 204

Salut,

Il manque peut être ceci:

Set dico = CreateObject("scripting.dictionary")

;0)

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

bonjour,

hé oui! merci :o)

rocornet

maintenant C'a m'affiche: l'indice n'appartient pas à la sélection
en jaune: ref=T(x)

Réponse 3 / 3

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour,
Désolé, pas mal de trucs à faire cette semaine !

Option Explicit
Sub Selectionner_joueurs()
Dim Tablo(), Lig As Byte, Ref As String, Dico As Object, Joueurs()

Range("C2:C6").ClearContents
Set Dico = CreateObject("scripting.dictionary")

Tablo = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value 'renvoie un tableau de base 1
Randomize
While 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, ""
Wend
Joueurs = Dico.keys
Range("C2").Resize(Dico.Count, 1) = Application.Transpose(Joueurs)
End Sub

Michel

Discussions similaires

Voxbone ? qui est-ce ?

5 bips au demarage de hp

paiment 4x nickel sur top achat

une image de quelque seconde sur une vidéo

Paiement en 4 fois cdiscount

Votre réponse

Discussions similaires