XL pour MAC Tirage au sort multiples

[bob82]

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]

Bonjour bob82, bienvenue sur XLD,

Voyez le fichier joint et cette macro :

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+

 

[bob82]

Super merci beaucoup, je vais pouvoir tester ça et revenir vers vous au plus vite pour vous confirmer.