抽奖程序怎么去重复

Jack000001

求助大神！！！

写了一个抽奖的小程序，卸载ToggleButton里面，现在能生成抽奖名单，但是生成中奖名单重复的问题，没有思路怎么去解决。
我想用字典的remove 去处理，但是发现ToggleButton_click是重新执行程序，上一步操作remove key 没有意义。
求助大神指点一下！！！

代码：

Private Sub ToggleButton1_Click()
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheets("花名册").Range("a1", Sheets("花名册").Cells(Rows.Count, 1).End(xlUp))
    For i = 1 To UBound(arr)
        d(arr(i, 1)) = ""
    Next i
    If ToggleButton1.Value = True Then
        ToggleButton1.Caption = "暂停"
        Do
            n = Int((d.Count - 1 + 1) * Rnd + 1)
            Sheets("抽奖").Range("a1") = Application.WorksheetFunction.Index(d.keys, n)
            DoEvents
        Loop Until ToggleButton1.Value = False
    Else
    ToggleButton1.Caption = "开始"
        Sheets("抽奖").Cells(Rows.Count, "k").End(xlUp).Offset(1, 0) = Sheets("抽奖").Range("a1")
        r = Sheets("抽奖").Range("a1")
        d.Remove (r)
    End If
End Sub


已上传附件。

liulang0808

Private Sub ToggleButton1_Click()
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheets("花名册").Range("a1", Sheets("花名册").Cells(Rows.Count, 1).End(xlUp))
    For i = 1 To UBound(arr)
        d(arr(i, 1)) = ""
    Next i
    arr = Sheets("抽奖").Range("K1", Sheets("抽奖").Cells(Rows.Count, "K").End(xlUp))
    For i = 2 To UBound(arr)
        If d.EXISTS(arr(i, 1)) Then d.Remove (arr(i, 1))
    Next i
    If d.Count = 0 Then
        MsgBox "无抽奖人员！"
        Exit Sub
    End If
    If ToggleButton1.Value = True Then
        ToggleButton1.Caption = "暂停"
        Do
            n = Int((d.Count - 1 + 1) * Rnd + 1)
            Sheets("抽奖").Range("a1") = Application.WorksheetFunction.Index(d.keys, n)
            DoEvents
        Loop Until ToggleButton1.Value = False
    Else
    ToggleButton1.Caption = "开始"
        Sheets("抽奖").Cells(Rows.Count, "k").End(xlUp).Offset(1, 0) = Sheets("抽奖").Range("a1")
        r = Sheets("抽奖").Range("a1")
        d.Remove (r)
    End If
End Sub

liulang0808

附件内容供参考。。。。。

Jack000001

liulang0808 发表于 2023-5-18 07:08
Private Sub ToggleButton1_Click()
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheet ...

谢谢大神 学到处理思路了！当时只想着在ToggleButton的true 或false 里面去掉已抽出来的人员，都没想过直接在外层先remove.
谢谢大神！感恩