Discussion :

[yanlau1977]

Bonjour,

Je voudrais faire un petit programme excel très simple

Dans les cellules A1 à A30 ou A40 (environ) je veux inscrire tous les amis invités de mon fils.

Ensuite, je veux faire un tirage de 5 cadeaux. Les amis ne peuvent pas gagner plus d'une fois.

J'ai fait une fonction qui me permet de savoir le nombre d'enfants ... c'est déjà un bon début

Maintenant je voudrais bâtir une liste de tous les noms en mémoire et faire un random pour avoir 1 gagnant, enlever ce gagnant de la liste, refaire un random, enlever ce gagnant, etc ... le tout 5 fois.

Merci pour votre aide

[kiki29]

Salut, t'inspirer de http://excel.developpez.com/faq/?pag...rieNombresAlea

[yanlau1977]

Merci pour l'aide l'ami ... je ne suis vraiment plus loin de solutionner le problème ...

Voici un exemple de feuille excel pour expliquer mon problème :
où A1 représente mon nombre de participant au tirage (5 dans cet exemple)
5 Cadeau 1 Cadeau 2 Cadeau 3 Cadeau 4 Cadeau 5
1
2
3
4
5

Voici l'appel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub Test()
 
    Dim NombreCadeau As Integer
    NombreCadeau = Range("A1").Value
    GenereSerieAleatoireSansDoublons NombreCadeau, Range("B2")
End Sub

Voici la procedure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub GenereSerieAleatoireSansDoublons(NbValeurs As Integer, Cell As Range)
    Dim Tableau() As Integer, TabNumLignes() As Integer
    Dim i As Integer, k As Integer, c As Integer
 
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
 
    c = 2
 
    For i = 1 To NbValeurs
        TabNumLignes(i) = i
        Tableau(i) = i
    Next
 
    'Initialise le générateur de nombres aléatoires
    Randomize
 
    For i = NbValeurs To 1 Step -1
        k = Int((i * Rnd) + 1)
        'Cells(k + 1, c) = Tableau(TabNumLignes(k))
        Cells(k + 1, c) = "BRAVO"
        c = c + 1
        TabNumLignes(k) = TabNumLignes(i)
    Next
 
End Sub

Résultats :

5	Cadeau 1	Cadeau 2	Cadeau 3	Cadeau 4	Cadeau 5
1	BRAVO			BRAVO	BRAVO
2		BRAVO	BRAVO		
3					
4					
5

Le # du gagnant est le BRAVO ... mais en réalité le BRAVO est le # du gagnant ... il ne va pas se mettre à la bonne ligne ... pourquoi ??

En inversant le commentaire, on comprend mieux mon explication ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
        Cells(k + 1, c) = Tableau(TabNumLignes(k))
        'Cells(k + 1, c) = "BRAVO"

Désolé ... si quelqu'un comprend mes explications, c'est probablement un DIEU

[kiki29]

Re, en fait dans la colonne A les participants et dans la colonne B on génère les nombres aléatoires
de 1 au nombre de participants , et ceux qui ont en vis à vis de leur nom les numéros 1 à 5
recevront les cadeaux correspondants

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
Sub Test()
Dim LastRow As Long
    LastRow = ShTst.Range("A" & Rows.Count).End(xlUp).Row
    ShTst.Columns("B:B").ClearContents
    Application.ScreenUpdating = False
    GenereSerieAleatoireSansDoublons LastRow, ShTst.Range("B1")
    Application.ScreenUpdating = True
End Sub
 
Private Sub GenereSerieAleatoireSansDoublons(NbValeurs As Long, Cell As Range)
Dim Tableau() As Long, TabNumLignes() As Long
Dim i As Long, k As Long
 
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
 
    For i = 1 To NbValeurs
        TabNumLignes(i) = i
        Tableau(i) = i
    Next i
 
    Randomize
 
    For i = NbValeurs To 1 Step -1
        k = Int((i * Rnd) + 1)
        ShTst.Cells(Cell.Row + i - 1, Cell.Column) = Tableau(TabNumLignes(k))
        TabNumLignes(k) = TabNumLignes(i)
    Next i
End Sub

ShTst est le CodeName attribué à Feuil1 ou Sheet1 chez toi, voir http://www.developpez.net/forums/d92...cel/vba-bases/

[yanlau1977]

Merci Kiki ... à lire ton code, je crois que tu as compris parfaitement mon besoin malgrè mes explications brouillées ...

J'ai hâte d'essayer le tout ce soir à la maison ... je te redonne des nouvelles.

[yanlau1977]

Dommage, ca ne fonctionne pas tel que prévue ... surement que mes explications manques de clartés ... je recommence avec cet exemple

J'ai le tableau suivant :
6 Cadeau 1 Cadeau 2 Cadeau 3 Cadeau 4 Cadeau 5 Cadeau 6
1
2
3
4
5
6
7
8
9
10
11
12
13
la cellule A1 représente le nombre de cadeau offert, dans cet exemple "6"
Les lignes A2 et plus ... le nombre de participant au tirage.

Je veux générer un nombre aléatoire entre 1 et le nombre de participant pour chacun des cadeaux. Un participant ne peut pas gagner plus d'une fois ... la fonction GenereSerieAleatoireSansDoublons fonctionne parfaitement pour éviter d'avoir un gagnant en double ...

Là où ca accroche, c'Est que vis à vis chacun des participants, je veux inscrire "BRAVO" pour chacun des cadeaux ... c'est ca qui ne fonctionne pas ...

Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub TestY()
 
    Dim NombreCadeau As Integer
    NombreCadeau = Range("A1").Value
    Feuil2.Range("B2", "G14").ClearContents
    GenereSerieAleatoireSansDoublons NombreCadeau, Range("B2")
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub GenereSerieAleatoireSansDoublons(NbValeurs As Integer, Cell As Range)
    Dim Tableau() As Integer, TabNumLignes() As Integer
    Dim i As Integer, k As Integer, col As Integer
    Dim LastRow As Integer
 
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
 
    col = 2
 
    LastRow = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
    LastRow = LastRow - 1 'ENLEVER 1 valeur puisque A1 ne compte pas pour un participant ... pas très esthétique comme programmation désolé
 
    For i = 1 To NbValeurs
        TabNumLignes(i) = i
        Tableau(i) = i
    Next
 
    'Initialise le générateur de nombres aléatoires
    Randomize
 
    For i = NbValeurs To 1 Step -1
        k = Int((i * Rnd) + 1)
        Cells(k + 1, col) = Tableau(TabNumLignes(k))
        'Cells(k + 1, col) = "BRAVO"
        col = col + 1
        TabNumLignes(k) = TabNumLignes(i)
    Next
 
End Sub

Et voici le résultat
6 Cadeau 1 Cadeau 2 Cadeau 3 Cadeau 4 Cadeau 5 Cadeau 6
1 1 3 6
2 2
3
4 4
5 5
6
7
8
9
10
11
12
13
Dans cet exemple, ca fonctionné pour le cadeau 1,2,3 et 4. Le 5e cadeau, c'est le 3e participant qui aurait du gagné, mais ca écrit au participant 1, pareil pour le cadeau #6 ...

Merci

[yanlau1977]

C'est dommage, mon message de 00h44 était tellement prêt de la vérité ...

Il manque un petit truc qui sort de mes connaissances ... Il doit bien avoir un génie dans ce Forum qui trouverait le petit bug !!!

à suivre ...

[kiki29]

Re, au plus simple en reportant le tirage sur une autre feuille avec un CodeName ShCad, mais en une seule étape et pas en 6

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Const NbCadeaux As Long = 6
 
Sub Test()
Dim LastRow As Long
    LastRow = ShTst.Range("A" & Rows.Count).End(xlUp).Row
    ShTst.Columns("B:C").ClearContents
    Application.ScreenUpdating = False
    GenereSerieAleatoireSansDoublons LastRow, ShTst.Range("B1")
    Application.ScreenUpdating = True
End Sub
 
Private Sub GenereSerieAleatoireSansDoublons(NbValeurs As Long, Cell As Range)
Dim Tableau() As Long, TabNumLignes() As Long
Dim i As Long, k As Long
 
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
 
    For i = 1 To NbValeurs
        TabNumLignes(i) = i
        Tableau(i) = i
    Next i
 
    Randomize
 
    For i = NbValeurs To 1 Step -1
        k = Int((i * Rnd) + 1)
        ShTst.Cells(Cell.Row + i - 1, Cell.Column) = Tableau(TabNumLignes(k))
        TabNumLignes(k) = TabNumLignes(i)
    Next i
 
    ShCad.Cells.Clear
    For i = 1 To NbValeurs
        If ShTst.Range("B" & i) <= NbCadeaux Then
            ShTst.Range("C" & i) = "Bravo"
 
            ShCad.Cells(1, ShTst.Range("B" & i)) = "Cadeau " & ShTst.Range("B" & i)
            ShCad.Cells(2, ShTst.Range("B" & i)) = ShTst.Range("A" & i)
        End If
    Next i
End Sub

[yanlau1977]

Merci Kiki, ton dernier exemple ma permis de trouver la réponse à mon problème ... j'apprécie.

Désolé pour les gestionnaires du Forum, mais je ne sais pas comment vous faite pour écrire en code dans un post ... si quelqu'un peut me donner un tips, je me corrigerais pour mes prochains post.

J'ai mon tableau de créé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ReDim Tableau(NombreEnfant) 'il y a 25 enfants

Je fais un tirage de cadeau "RANDOM" sur 1 des 25 enfants

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

k = Int((NombreEnfant * Rnd) + 1)

Le gagnant est l'enfant #12 admettons ...

Comment je fais pour enlever l'enfant #12 de mon tableau ?

J'ai essayé plusieurs trucs et je ne trouve pas ...

[casefayere]

Bonjourà tou(te)s, yanlau1977

Désolé pour les gestionnaires du Forum, mais je ne sais pas comment vous faite pour écrire en code dans un post ... si quelqu'un peut me donner un tips, je me corrigerais pour mes prochains post.

Juste au dessus de ton message, tu as "#", cliques dessus et écris ton code à l'intérieur ou écris ton code, selectionnes le et cliques sur "#"

Bonne journée

[yanlau1977]

TEST - TEST

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ReDim Tableau(NombreEnfant) 'il y a 25 enfants

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

k = Int((NombreEnfant * Rnd) + 1)

[mercatog]

Bonjour
Ci-joint une proposition (avec la disposition des données comme ceci)

Feuille: Feuille nommée Feuil1
En colonne A à partir de A2 la liste des amis
En Ligne 1 à partir de B1, la liste des cadeaux

La procédure DispatchCadeaux permet d'inscrire BRAVO dans la cellule d'intersection du cadeau avec la personne tirée aléatoirement.

Code utilisant les variables tableaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub DispatchCadeaux()
Dim m As Integer, n As Integer, i As Integer, j As Integer
Dim Res() As String
Dim Tb() As Integer
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    n = .Range("A1").End(xlDown).Row - 1
    m = .Range("A1").End(xlToRight).Column - 1
 
    ReDim Tb(1 To n)
    For i = 1 To n
        Tb(i) = i
    Next i
 
    ReDim Res(1 To n, 1 To m)
 
    For j = 1 To m
        Call AleaPermut(Res, Tb, j)
    Next j
 
    .Range("B2").Resize(n, m) = Res
End With
End Sub
 
 
Private Sub AleaPermut(ByRef Mtr, ByRef Vct, ByVal k As Integer)
Dim p As Integer, i As Integer, q As Integer
 
q = UBound(Mtr, 1) - k + 1
 
Randomize
p = Int(q * Rnd) + 1
Mtr(Vct(p), k) = "BRAVO"
 
For i = 1 To q - 1
    Vct(i) = IIf(i < p, Vct(i), Vct(i + 1))
Next i
End Sub