[XL-2007] Aléa sans remise

[Alqualonde]

Bonjour,

C'est mon premier post ici, j'espère qu'il sera utile à certains !

J'ai eu besoin d'utiliser un aléa sans remise et toutes mes recherches n'ayant pas abouti à ce que je souhaitais exactement, je m'y suis collé et voici le code qui en est issu. Il n'est surement pas optimal...

Code :

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub Alea()
' Macro pour calculer un aléa sans remise
 
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer
    Dim n As Integer ' Nombre de participants
 
    Dim trouve As Integer
    Dim trouve2 As Integer
 
    Dim feuilleAModifier As Worksheet
    Set feuilleAModifier = Worksheets("Bonus aléa")
 
    Dim a As Double
 
    n = feuilleAModifier.Range("A65536").End(xlUp).Row - 1
    feuilleAModifier.Range("C2:C1000").ClearContents
    feuilleAModifier.Range("D2:D1000").ClearContents
 
    ' Initialisations
    i = 1
    j = 0
    k = 1
    trouve = 0
    trouve2 = 0
 
    Do While (i < n + 1) ' tant que tous les participants n'ont pas eu leur aléa
        Randomize
        a = Rnd() ' nombre aléatoire entre 0 et 1
        j = 0
        trouve = 0
        Do While trouve = 0 ' vérification de la valeur de l'aléa par rapport à la tranche dépendant du nombre de participants
            If a < j / n Then
                feuilleAModifier.Cells(i + 1, 3) = j    ' affectation dans la cellule
                trouve = 1    ' sortie de la boucle do while
            Else
                j = j + 1 ' incrémentation du compteur
                feuilleAModifier.Cells(i + 1, 4) = a
            End If
        Loop
 
        Do While (trouve2 = 0 And k < i) ' Vérification que l'on n'a pas déjà pris ce nombre
            If (feuilleAModifier.Cells(k + 1, 3).Value <> j) Then
                k = k + 1
            Else
                trouve2 = 1
            End If
        Loop
 
        If trouve2 = 0 Then
            i = i + 1 ' Si on a un nouveau nombre alors on l'affecte
        Else
            feuilleAModifier.Cells(i + 1, 3).ClearContents ' Sinon on efface et on repart
        End If
 
        k = 1
        trouve2 = 0
 
    Loop
 
End Sub

A noter que j'aurais pu utiliser des Boolean et non des Integer pour les deux variables trouve et trouve2...