Microsoft 365 Tirage au sort avec handicap

Informatique661 · 1 Avril 2021

Bonsoir !

Je suis tombé sur un site qui permet de réaliser des tirages au sort avec différents niveaux de pondération (https://www.tirage-au-sort.net/tirage-pondere) et je voudrai parvenir à obtenir le même résultat dans un fichier excel, cependant, je ne sais pas du tout par où commencer...

Mon objectif est de réaliser des tirages au sort (pour un nombre de participant pouvant aller de plusieurs dizaines à plusieurs centaines de participants) avec un seul gagnant, mais de permettre à trois participants de bénéficier de plus de chances que les autres d'être tiré au sort.

Dans le générateur cité, il me suffit de mettre les trois participants dans un "pot" avec une probabilité par exemple de 400 % (les probabilités sont alors augmentées par 4), tandis que je rentre tous les autres participants dans un autre "pot" avec la probabilité basique de 100 % (sans pondération).

Est-il possible d'obtenir la même chose avec excel ? Si oui, par ou commencer ? Je suis un bleu dans ce domaine, mais j'apprends vite !

Merci d'avance à ceux qui pourront m'apporter des éléments de réponse

mapomme · 2 Avril 2021

Bonjour à tous,

La même chose en VBA.
Les chances sont exprimés en unité: 1 correspond à 100%, 10 correspond à 10 fois plus de chance, 2,5 correspond à deux fois et demi plus de chance (se limiter à un chiffre après la virgule)

Cliquez sur le bouton Hop!
Dans le code (dans le module de la feuille Feuil1), une constante nTirage permet de modifier le nombre de tirage (de base c'est 1 000 000 de tirages).

VB:

Const nTirage = 1000000

Sub tirage()
Dim der&, n, t, t0, i&, j&, k&, m&, aux
   der = Cells(Rows.Count, 2).End(xlUp).Row: t = Range("a2:c" & der)
   For i = 1 To UBound(t): n = n + 10 * t(i, 2): t(i, 3) = 0: Next
   ReDim t0(1 To n)
   For i = 1 To UBound(t): For k = 1 To 10 * t(i, 2): m = m +...

job75 · 2 Avril 2021

Bonjour Mot661, le forum,

C'est très simple voyez le fichier joint.

Pour que les joueurs Nom1 Nom2 Nom3 aient 4 fois plus de chances que les autres il suffit que leurs noms soient 4 fois dans la liste du tirage.

Formule en D2 =INDEX(A:A;ALEA.ENTRE.BORNES(2;110))

A+

mapomme · 2 Avril 2021

Bonjour à tous,

La même chose en VBA.
Les chances sont exprimés en unité: 1 correspond à 100%, 10 correspond à 10 fois plus de chance, 2,5 correspond à deux fois et demi plus de chance (se limiter à un chiffre après la virgule)

Cliquez sur le bouton Hop!
Dans le code (dans le module de la feuille Feuil1), une constante nTirage permet de modifier le nombre de tirage (de base c'est 1 000 000 de tirages).

VB:

Const nTirage = 1000000

Sub tirage()
Dim der&, n, t, t0, i&, j&, k&, m&, aux
   der = Cells(Rows.Count, 2).End(xlUp).Row: t = Range("a2:c" & der)
   For i = 1 To UBound(t): n = n + 10 * t(i, 2): t(i, 3) = 0: Next
   ReDim t0(1 To n)
   For i = 1 To UBound(t): For k = 1 To 10 * t(i, 2): m = m + 1: t0(m) = i: Next k, i
   Randomize
   For i = 1 To n: For j = 1 To 5: k = 1 + Int(Rnd * n): aux = t0(i): t0(i) = t0(k): t0(k) = aux: Next j, i
   For i = 1 To nTirage: k = 1 + Int(Rnd * n): t(t0(k), 3) = t(t0(k), 3) + 1: Next i
   Range("a2").Resize(UBound(t), 3).Value = t
   Range("c" & der + 1 & ":c" & Rows.Count).Clear
End Sub

Informatique661 · 2 Avril 2021

job75 à dit:
Bonjour Mot661, le forum,

C'est très simple voyez le fichier joint.

Pour que les joueurs Nom1 Nom2 Nom3 aient 4 fois plus de chances que les autres il suffit que leurs noms soient 4 fois dans la liste du tirage.

Formule en D2 =INDEX(A:A;ALEA.ENTRE.BORNES(2;110))

A+

Merci beaucoup ! J'y avais pensé mais je me demandai si cela donnerait le même résultat que sur le site (cela me paraissait presque trop simple) XD

Informatique661 · 2 Avril 2021

mapomme à dit:
Bonjour à tous,

La même chose en VBA.
Les chances sont exprimés en unité: 1 correspond à 100%, 10 correspond à 10 fois plus de chance, 2,5 correspond à deux fois et demi plus de chance (se limiter à un chiffre après la virgule)

Cliquez sur le bouton Hop!
Dans le code (dans le module de la feuille Feuil1), une constante nTirage permet de modifier le nombre de tirage (de base c'est 100 000 tirages).

VB:

Const nTirage = 100000 Sub tirage() Dim der&, n, t, t0, i&, j&, k&, m&, aux der = Cells(Rows.Count, 2).End(xlUp).Row: t = Range("a2:c" & der) For i = 1 To UBound(t): n = n + 10 * t(i, 2): t(i, 3) = 0: Next ReDim t0(1 To n) For i = 1 To UBound(t): For k = 1 To 10 * t(i, 2): m = m + 1: t0(m) = i: Next k, i Randomize For i = 1 To n: For j = 1 To 5: k = 1 + Int(Rnd * n): aux = t0(i): t0(i) = t0(k): t0(k) = aux: Next j, i For i = 1 To nTirage: k = 1 + Int(Rnd * n): t(t0(k), 3) = t(t0(k), 3) + 1: Next i Range("a2").Resize(UBound(t), 3).Value = t Range("c" & der + 1 & ":c" & Rows.Count).Clear End Sub

C'est presque de la magie pour moi ce que tu viens de faire XD juste hop et j'obtiens le tirage. Merci énormément !

Est-ce qu'il y aurait un moyen de mettre une case pour obtenir en plus, le gagnant d'un seul tirage ? Parce que je trouve très utile d'avoir les proba sur 10 000 tirages pour avoir une idée, mais je ne sais pas comment faire pour annoncer le gagnant ^^

En gros, c'est un mix entre vos deux fichiers ^^

Merci infiniment de votre aide par avance !

job75 · 2 Avril 2021

Bonjour mapomme,

Mot661 à dit:
Est-ce qu'il y aurait un moyen de mettre une case pour obtenir en plus, le gagnant d'un seul tirage ?

Pour obtenir le gagnant du dernier tirage ajoutez cette instruction à la fin de la macro de mapomme :

VB:

[E3] = "Gagnant du dernier tirage : " & t(t0(k), 1)

A+

Informatique661 · 2 Avril 2021

Merci beaucoup pour votre aide à tous c'était efficace et rapide !

mapomme · 2 Avril 2021

Re à tous,

Une autre façon :

mettre la constante nTirage à 1
Cliquez sur le bouton Hop!

La ligne du gagnant se met en jaune (via une MFC).
Le gagnant est reporté (par une formule) dans la cellule E4.

Informatique661 · 2 Avril 2021

mapomme à dit:
Re à tous,

Une autre façon :

mettre la constante nTirage à 1

Cliquez sur le bouton Hop!

La ligne du gagnant se met en jaune (via une MFC).
Le gagnant est reporté (par une formule) dans la cellule E4.

Merci !

Microsoft 365 Tirage au sort avec handicap

Informatique661

XLDnaute Nouveau

mapomme

job75

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Informatique661

XLDnaute Nouveau

Informatique661

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Informatique661

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Pièces jointes

Informatique661

XLDnaute Nouveau

Discussions similaires