用EXCEL VBA編寫模擬器可以避免誤操作導(dǎo)致的數(shù)據(jù)刷新（用excel擬合曲線）

*實(shí)例*

抽獎(jiǎng)編號(hào)：5位

在前文《EXCEL RAND、RANK、INDEX函數(shù)搞定年會(huì)抽獎(jiǎng)器》，筆者利用EXCEL的函數(shù)制作了簡(jiǎn)單的模擬隨機(jī)抽獎(jiǎng)器。

該方法，具有明顯的缺陷，就是“誤操作會(huì)導(dǎo)致數(shù)據(jù)刷新”，本文使用EXCEL VBA進(jìn)行簡(jiǎn)單模擬器編寫：

更好地避免“誤操作導(dǎo)致的數(shù)據(jù)刷新”

準(zhǔn)確記錄已經(jīng)中獎(jiǎng)的名單

支持10000條以內(nèi)的“抽獎(jiǎng)編號(hào)”數(shù)據(jù)添加

缺陷：抽獎(jiǎng)編號(hào)只支持3-5位數(shù)，其它不能自適應(yīng)，需修改代碼

步驟一：界面設(shè)計(jì)

單元格B：C區(qū)域，輸入“抽獎(jiǎng)編號(hào)”數(shù)據(jù)，并為其分配自增的不重復(fù)編號(hào)（1-10003）

單元格E3：I3區(qū)域，為搖獎(jiǎng)過(guò)程展示區(qū)域，點(diǎn)擊【開(kāi)始】按鈕后，E3：I3區(qū)域會(huì)持續(xù)閃爍，點(diǎn)擊【結(jié)束】，E3：I3停下，并將搖獎(jiǎng)結(jié)果復(fù)制到L列

單元格L列，為【結(jié)束】后保存之前的搖獎(jiǎng)結(jié)果，點(diǎn)擊【重置】按鈕，將清除E3：I3搖獎(jiǎng)區(qū)域和L列的數(shù)據(jù)

步驟二：EXCEL VBA代碼

===============開(kāi)始================

Dim rollID() As String ? ? ? ?'設(shè)定動(dòng)態(tài)抽獎(jiǎng)編號(hào)數(shù)組

Dim isScroll As Boolean ? ?'設(shè)定控制結(jié)束的布爾值

Sub rollReward()

'為動(dòng)態(tài)數(shù)組確定大小

Dim a As Integer

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

'最多在B列支持10000條數(shù)據(jù)（年會(huì)抽獎(jiǎng)，每次抽1人，足夠了）

ReDim rollID(1 To a)

'為抽獎(jiǎng)編號(hào)賦值

Dim i As Integer

For i = 1 To a Step 1

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

Next i

Randomize ?'初始化隨機(jī)數(shù)生成器

Dim j As Integer

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

isScroll = False ?'初始化“控制結(jié)束”標(biāo)記為false

Dim rollstr As String

rollstr = rollID(j)

Range("E3").Value = Mid(rollstr, 1, 1) '抽獎(jiǎng)編號(hào)第1位數(shù)組，填充在E3單元格

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

Range("F3").Value = Mid(rollstr, 2, 1) '抽獎(jiǎng)編號(hào)第2位數(shù)組，填充在F3單元格

Range("G3").Value = Mid(rollstr, 3, 1) '抽獎(jiǎng)編號(hào)第3位數(shù)組，填充在G3單元格

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

If Len(rollstr) >= 4 Then

Range("H3").Value = Mid(rollstr, 4, 1) '抽獎(jiǎng)編號(hào)第4位數(shù)組，填充在H3單元格

End If

If Len(rollstr) >= 5 Then

Range("I3").Value = Mid(rollstr, 4, 1) '抽獎(jiǎng)編號(hào)第4位數(shù)組，填充在I3單元格

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

End If

DoEvents '釋放程序控制權(quán)

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 '判斷控制結(jié)束的標(biāo)記是否為true，是就跳出sub

End If

Call rollReward '調(diào)用程序自身，重新生成新的隨機(jī)結(jié)果

End Sub

Sub gameover()

isScroll = True ?'將控制結(jié)束的標(biāo)記置為true

End Sub

'重置搖獎(jiǎng)區(qū)和結(jié)果展示區(qū)數(shù)據(jù)

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

===============結(jié)束================

步驟三：測(cè)試3位、4位、3-5位抽獎(jiǎng)編號(hào)表現(xiàn)

抽獎(jiǎng)編號(hào)：3位

抽獎(jiǎng)編號(hào)：4位

抽獎(jiǎng)編號(hào)：3-5位

*方法局限*

只能支持3-5位抽獎(jiǎng)編號(hào)

抽獎(jiǎng)編號(hào)必須與實(shí)際參與者一一對(duì)應(yīng)，且無(wú)法一次性抽多人

無(wú)法排除已經(jīng)中獎(jiǎng)的編號(hào)

版權(quán)聲明：本文內(nèi)容由網(wǎng)絡(luò)用戶投稿，版權(quán)歸原作者所有，本站不擁有其著作權(quán)，亦不承擔(dān)相應(yīng)法律責(zé)任。如果您發(fā)現(xiàn)本站中有涉嫌抄襲或描述失實(shí)的內(nèi)容，請(qǐng)聯(lián)系我們jiasou666@gmail.com 處理，核實(shí)后本網(wǎng)站將在24小時(shí)內(nèi)刪除侵權(quán)內(nèi)容。