用EXCEL VBA編寫模擬器可以避免誤操作導致的數據刷新（用excel怎么做曲線圖）

*實例*

抽獎編號：5位

在前文《EXCEL RAND、RANK、INDEX函數搞定年會抽獎器》，筆者利用EXCEL的函數制作了簡單的模擬隨機抽獎器。

該方法，具有明顯的缺陷，就是“誤操作會導致數據刷新”，本文使用Excel VBA進行簡單模擬器編寫：

更好地避免“誤操作導致的數據刷新”

準確記錄已經中獎的名單

支持10000條以內的“抽獎編號”數據添加

缺陷：抽獎編號只支持3-5位數，其它不能自適應，需修改代碼

步驟一：界面設計

單元格B：C區域，輸入“抽獎編號”數據，并為其分配自增的不重復編號（1-10003）

單元格E3：I3區域，為搖獎過程展示區域，點擊【開始】按鈕后，E3：I3區域會持續閃爍，點擊【結束】，E3：I3停下，并將搖獎結果復制到L列

單元格L列，為【結束】后保存之前的搖獎結果，點擊【重置】按鈕，將清除E3：I3搖獎區域和L列的數據

步驟二：EXCEL VBA代碼

===============開始================

Dim rollID() As String ? ? ? ?'設定動態抽獎編號數組

Dim isScroll As Boolean ? ?'設定控制結束的布爾值

Sub rollReward()

'為動態數組確定大小

Dim a As Integer

a = Application.WorksheetFunction.Max(Range("B3:B10003").Value)

'最多在B列支持10000條數據（年會抽獎，每次抽1人，足夠了）

ReDim rollID(1 To a)

'為抽獎編號賦值

Dim i As Integer

For i = 1 To a Step 1

rollID(i) = Cells(2 + i, 3)

Next i

Randomize ?'初始化隨機數生成器

Dim j As Integer

j = Int(Rnd() * a + 1)

isScroll = False ?'初始化“控制結束”標記為false

Dim rollstr As String

rollstr = rollID(j)

Range("E3").Value = Mid(rollstr, 1, 1) '抽獎編號第1位數組，填充在E3單元格

Range("E3").Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '隨機填充顏色

Range("F3").Value = Mid(rollstr, 2, 1) '抽獎編號第2位數組，填充在F3單元格

Range("G3").Value = Mid(rollstr, 3, 1) '抽獎編號第3位數組，填充在G3單元格

Range("G3").Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '隨機填充顏色

If Len(rollstr) >= 4 Then

Range("H3").Value = Mid(rollstr, 4, 1) '抽獎編號第4位數組，填充在H3單元格

End If

If Len(rollstr) >= 5 Then

Range("I3").Value = Mid(rollstr, 4, 1) '抽獎編號第4位數組，填充在I3單元格

Range("I3").Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '隨機填充顏色

End If

DoEvents '釋放程序控制權

Dim b As Integer

b = Range("K1").Value

If isScroll = True Then

b = b + 1

Range("K1").Value = b

Range("K" & b + 2).Value = b

Range("L" & b + 2).Value = rollID(j)

Exit Sub '判斷控制結束的標記是否為true，是就跳出sub

End If

Call rollReward '調用程序自身，重新生成新的隨機結果

End Sub

Sub gameover()

isScroll = True ?'將控制結束的標記置為true

End Sub

'重置搖獎區和結果展示區數據

Sub resetGame()

Range("k1").ClearContents

Range("k3:K10003").ClearContents

Range("L3:L10003").ClearContents

Range("E3:I3").Interior.Color = RGB(255, 255, 255)

Range("E3:I3").Value = ""

End Sub

===============結束================

步驟三：測試3位、4位、3-5位抽獎編號表現

抽獎編號：3位

抽獎編號：4位

抽獎編號：3-5位

*方法局限*

只能支持3-5位抽獎編號

抽獎編號必須與實際參與者一一對應，且無法一次性抽多人

無法排除已經中獎的編號

版權聲明：本文內容由網絡用戶投稿，版權歸原作者所有，本站不擁有其著作權，亦不承擔相應法律責任。如果您發現本站中有涉嫌抄襲或描述失實的內容，請聯系我們jiasou666@gmail.com 處理，核實后本網站將在24小時內刪除侵權內容。