随机点名

源码

Option Explicit
Dim CurrentNo As Integer '当前序号
Dim NameCount As Integer '总人数
Dim Sorted As Boolean '是否已经排序
Dim vWords As Variant
Dim sData As String
Dim nWordsList() As Long

Private Sub CommandButton1_Click()

If Sorted = False Then

    sData = "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"
    vWords = Split(sData, ",")

    Randomize
    Dim nCount As Long
    Dim nGetCnt As Long

    Dim nPos As Long
    Dim i As Long
    Dim bExist As Boolean
    Dim sWords As String

    nCount = UBound(vWords)
    NameCount = nCount

    ReDim nWordsList(nCount) As Long

    For i = 0 To nCount
        nWordsList(i) = -1
    Next i

    Do While nGetCnt < nCount + 1
        nPos = Rnd * nCount
        bExist = False

        For i = 0 To nCount
            If nPos = nWordsList(i) Then
                bExist = True
            End If
        Next i

        If Not bExist Then
            nWordsList(nGetCnt) = nPos
            nGetCnt = nGetCnt + 1
        End If
    Loop
    Sorted = True
End If

    Person_Name.Caption = vWords(nWordsList(CurrentNo))
    If CurrentNo < NameCount Then
        CurrentNo = CurrentNo + 1
    Else
        MsgBox "点名结束!"
    End If
End Sub

Private Sub CommandButton2_Click()
    Sorted = False
    CurrentNo = 0
    NameCount = 0
    Person_Name.Caption = ""
End Sub

Private Sub Person_Name_Click()

End Sub
Last modification:March 4th, 2020 at 07:08 pm
If you think my article is useful to you, please feel free to appreciate