2 在妳的窗體上放置壹個按鈕Command1和壹個ListBox控件List1
3 粘貼以下代碼：
Option Explicit
Private Type ShuZu '自定義數據結構
CaiPiao As String '彩票編號
DengJi As String '獎金等級
XuanZHong As Boolean '被抽中標記
End Type
Dim SZ() As ShuZu '用自定義結構創建動態數組
Private Function SuiJiChouQu(XiaXian As Long) As Long
'===================================================
'自定義函數：返回 1 到參數 XiaXian 之間的隨機數值。
'===================================================
' 區間隨機數公式 = Int((上限 - 下限 + 1) * Rnd + 下限
SuiJiChouQu = Int((XiaXian * Rnd) + 1)
End Function
Private Sub CreatCaiPiao()
'==================================================
'功能: 創建1000張由7位數字組成的彩票
'==================================================
Dim I As Integer
Dim X As Long
Dim S As String
Randomize '初始化
For I = 1 To 1000
ReDim Preserve SZ(I) '動態添加數組元素
X = SuiJiChouQu(10000000) '調用自定義函數獲取隨機數
S = Trim(Str(X)) '把隨機數轉換為字符串
SZ(I).CaiPiao = Right("0000000" & S, 7) '不夠7位的則補零湊足7位
SZ(I).DengJi = "" '默認無獎
SZ(I).XuanZHong = False '默認不曾被選中
Next I
End Sub
Private Sub SetDJ()
'=======================================================
'功能： 設定票等級
'=======================================================
Dim X As Integer, I As Integer
Dim S As String
I = 1
Do While I < 76 '1 到 76 *** 75個有獎彩票
X = SuiJiChouQu(1000) '獲得1000以內的壹個隨機數
If Trim(SZ(X).DengJi) = "" Then '如果這張彩票沒被設定等級才處理
Select Case I
Case 1 To 5
S = "壹等獎"
Case 6 To 25
S = "二等獎"
Case Else
S = "三等獎"
End Select
SZ(X).DengJi = S
I = I + 1
End If
Loop
End Sub
Private Sub ChouJiang()
'==================================================
'功能： 模擬抽獎
'==================================================
Dim X As Long
Dim A As Integer, B As Integer, C As Integer, I As Integer
Dim S As String
I = 1
List1.Clear
Do While I < 101
X = SuiJiChouQu(1000) '獲得1000以內的壹個隨機數
If SZ(X).XuanZHong = False Then '如果這張彩票沒有被人抽走
SZ(X).XuanZHong = True '標記該彩票已經作廢
S = Right("00" & Trim(Str(I)), 3) & " "
S = S & Trim(SZ(X).CaiPiao) & " " & Trim(SZ(X).DengJi)
List1.AddItem S
If Trim(SZ(X).DengJi) = "壹等獎" Then A = A + 1
If Trim(SZ(X).DengJi) = "二等獎" Then B = B + 1
If Trim(SZ(X).DengJi) = "三等獎" Then C = C + 1
I = I + 1
End If
Loop
List1.AddItem " "
List1.AddItem " 統計： "
List1.AddItem " 壹等獎： " & Trim(Str(A))
List1.AddItem " 二等獎： " & Trim(Str(B))
List1.AddItem " 三等獎： " & Trim(Str(C))
End Sub
Private Sub Command1_Click()
CreatCaiPiao
SetDJ
ChouJiang
End Sub
Private Sub Form_Load()
Me.Caption = "模擬抽獎"
Command1.Caption = "開始"
End Sub
Private Sub Form_Resize()
'=========================================
'功能：控件位置設定（可以不要）
'=========================================
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2, 6400, 3375
List1.Move 180, 180, 4500, 2400
Command1.Move 4935, 240, 1125, 480
End Sub