XL pour MAC Tirage au sort multiples

bob82

XLDnaute Nouveau
Bonjour,

Nous avons un jeu concours dans lequel nous allons avoir une liste de personnes qui va s'agrémenter au fil des jours.

Je dois faire 4 tirages au sorts sur cette liste.
46 gagnants le jour A,
23 gagnants le jour B,
46 gagnants le jour C,
25 gagnants le jour D.

Quand je passe au tirage au sort suivant, je ne dois pas avoir de personnes qui ont déjà été tiré au sort sur le/les tirages précédents. A la limite, ça, je peux le faire manuellement.

Auriez-vous une aide pour créer un fichier Excel pour que je puisse avoir un tirage au sort "automatique de plusieurs personnes en un coup" ?
toutes les solutions que j'ai trouvées sont un tirage au sort d'une personne à chque fois, mais pas plusieurs (en choisissant la valeur finale X-XXX).

D'avance merci,
 

job75

XLDnaute Barbatruc
Bonjour bob82, bienvenue sur XLD,

Voyez le fichier joint et cette macro :
VB:
Sub Tirages()
Range("B3:E" & Rows.Count).ClearContents 'RAZ
[B2] = Int(Val([B2])): [C2] = Int(Val([C2])): [D2] = Int(Val([D2])): [E2] = Int(Val([E2]))
If Application.CountIf([B2:E2], ">0") < 4 Then [B2:E2] = "": Exit Sub
Dim P As Range, pc&, boucle&, a$(), nmax&, i&, r, n, b$(), c$(), d$()
Set P = Range("A3", Range("A" & Rows.Count).End(xlUp))
If P.Row < 3 Then Exit Sub
pc = P.Count
1 If boucle = 1000 Then MsgBox "Liste insuffisante ou valeurs trop grandes en B2:E2 !": Exit Sub
boucle = boucle + 1
'---Choix 1---
ReDim a(1 To pc, 1 To 1)
nmax = [B2]
n = 0
For i = 1 To UBound(a)
    r = Int(1 + pc * Rnd)
    If a(r, 1) = "" Then n = n + 1: a(r, 1) = "X"
    If n = nmax Then Exit For
Next
If n < nmax Then boucle = 1000: GoTo 1
P.Columns(2) = a
'---Choix 2---
ReDim b(1 To pc, 1 To 1)
nmax = [C2]
n = 0
For i = 1 To UBound(a)
    r = Int(1 + pc * Rnd)
    If a(r, 1) & b(r, 1) = "" Then n = n + 1: b(r, 1) = "X"
    If n = nmax Then Exit For
Next
If n < nmax Then GoTo 1
P.Columns(3) = b
'---Choix 3---
ReDim c(1 To pc, 1 To 1)
nmax = [D2]
n = 0
For i = 1 To UBound(a)
    r = Int(1 + pc * Rnd)
    If a(r, 1) & b(r, 1) & c(r, 1) = "" Then n = n + 1: c(r, 1) = "X"
    If n = nmax Then Exit For
Next
If n < nmax Then GoTo 1
P.Columns(4) = c
'---Choix 4---
ReDim d(1 To pc, 1 To 1)
nmax = [E2]
n = 0
For i = 1 To UBound(a)
    r = Int(1 + pc * Rnd)
    If a(r, 1) & b(r, 1) & c(r, 1) & d(r, 1) = "" Then n = n + 1: d(r, 1) = "X"
    If n = nmax Then Exit For
Next
If n < nmax Then GoTo 1
P.Columns(5) = d
End Sub
A+
 

Pièces jointes

  • Tirages(1).xlsm
    27.4 KB · Affichages: 23

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG