Exclure le numéro de compteur dans la sélection de noms aléatoires dans Excel VBA

Question

J'ai un code fonctionnel que j'ai trouvé sur Internet où un nom est choisi au hasard dans la colonne A avec un compteur par défaut de "0" (colonne B). J'ai ajouté une modification où si le nom a été choisi, la valeur de "0" devient "1". Cependant, je ne sais pas où je peux ajouter la logique selon laquelle si la valeur de la colonne B est déjà égale à 1, elle ne sera pas incluse dans le prochain tirage au sort puisque, techniquement, la personne dont la valeur du compteur est égale à 1 a déjà gagné.

Les données de l'échantillon :

Names       | Counter
Newt        | 0
Thomas      | 0
Teresa      | 1
Katniss     | 0
Peeta       | 0
Gale        | 0
Haymitch    | 0
Hazel Grace | 0
Augustus    | 0

Code lorsque l'on clique sur "Draw Winner" :

Sub draw_winners()
    draw  
End Sub

Function draw()
    Dim x As Integer
    Dim delay_ms As Integer

    Dim prize_y As Integer
    Dim name_matched As Boolean

    Dim randm As Integer
    x = get_max

    'CELL (ROW, COLUMN)

    delay_ms = 20 'how many draws before final

draw_winner:
    randm = rand_num(x)
    Cells(1, 3).Value = Cells(randm, 1).Value
    'winner_window.winner_name.Caption = Cells(1, 3).Value
    name_matched = check_names(Cells(1, 3).Value, 1)
    If delay_ms > 0 Then
        WaitFor (0.1)
        delay_ms = delay_ms - 1
        GoTo draw_winner
    End If
    If name_matched = True Then
        GoTo draw_winner
    End If

    Cells(randm, 2).Value = 1

End Function

Function check_names(name As String, rndm As Integer) As Boolean
    Dim i As Integer
    Dim winner As String
    check_names = False
    i = 2
check_name:
    winner = Cells(i, 4).Value
    If winner <> "" Then
        If winner = name And i <> rndm Then
            check_names = True
        End If
    End If
    i = i + 1
    If i < 1000 Then
        GoTo check_name
    End If

End Function

Function get_max() As Integer
    Dim i As Integer
    i = 2
check_blank_cell:
    If Cells(i, 1).Value <> "" Then 'starts at the second row
        i = i + 1
        If i > 10000 Then
            MsgBox "Max Limit Reached!"
            Else
            GoTo check_blank_cell
        End If
    End If

    get_max = i - 1
End Function

Function rand_num(max As Integer) As Integer
    Dim Low As Double
    Dim High As Double
    Low = 2 '<<< CHANGE AS DESIRED
    High = max '20 '<<< CHANGE AS DESIRED
    r = Int((High - Low + 1) * Rnd() + Low)
    rand_num = r
End Function

Sub WaitFor(NumOfSeconds As Single)
    Dim SngSec As Single
    SngSec = Timer + NumOfSeconds

    Do While Timer < SngSec
        DoEvents
   Loop
End Sub

Je m'excuse si cette question a déjà été posée. Votre aide sera très appréciée.

Answer 1

La commande ci-dessous renvoie un tableau des noms qui n'ont pas encore gagné. Un nom est choisi au hasard et la colonne B est ajustée en conséquence. Cela peut s'avérer utile :

Sub Test()

Dim lr As Long
Dim arr As Variant
Dim nom As String
Dim rng As Range

With Sheet1 'Change accordingly

    'Get last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get range into memory (array)
    arr = Filter(.Evaluate("TRANSPOSE(If(B2:B" & lr & "=0,A2:A" & lr & ",""|""))"), "|", False)
    If UBound(arr) = -1 Then Exit Sub

    'Get a random name from array
    nom = arr(Int(Rnd() * (UBound(arr) + 1)))

    'Get the range where name resides
    Set rng = .Range("A2:A" & lr).Find(nom, LookIn:=xlValues, lookat:=xlWhole)

    'Change value in B column
    rng.Offset(, 1).Value = 1

    'Do something with randomly picked name
    Debug.Print nom

End With

End Sub

Answer 2

Un moyen simple (et rapide) serait de trier les données par compteur dans un premier temps (afin que tous les 0 les compteurs viennent en premier) avant de tirer un nouveau nom.

With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A:B")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

et utiliser la quantité de zéros x = Application.WorksheetFunction.CountIf(Range("B:B"), 0) comme maximum pour votre générateur de nombres aléatoires rand_num(x) . De cette façon, seuls les noms avec 0 sont dessinés.

Image 1 : Seules les lignes sélectionnées sont utilisées pour dessiner un nom.

Voir aussi Comment trier des données dans Excel à l'aide de VBA (guide étape par étape) .