最近有粉絲在后臺(tái)向我提了一個(gè)工作中的小需求，具體如下：

■ 因?yàn)楣疽M織一個(gè)知識(shí)競賽，其中有一個(gè)游戲環(huán)節(jié)，需要從一組名單中隨機(jī)選出指定數(shù)量的人員參加游戲，并且需要在大屏中滾動(dòng)名單以增強(qiáng)游戲緊張感。當(dāng)然最重要的是最終被選中的名單中不能有重復(fù)名單出現(xiàn)。她希望能通過Excel來實(shí)現(xiàn)這個(gè)需求。

需求分析：其實(shí)這個(gè)需求與抽獎(jiǎng)非常類似，我們可以通過Excel的VBA宏功能來編寫一個(gè)小工具來實(shí)現(xiàn)這個(gè)需求，說干就干，以下就是最終實(shí)現(xiàn)的成品效果：

抽獎(jiǎng)小工具演示

功能說明：

第1步、名單在sheet2《名單維護(hù)》工作表的A列中輸入

第2步、設(shè)置抽獎(jiǎng)人數(shù)

第3步、點(diǎn)擊開始按鈕，名單開始滾動(dòng)

第4步、點(diǎn)擊停止按鈕，出現(xiàn)獲獎(jiǎng)人員名單

制作步驟如下：

第一步：制作表格

• 建立兩個(gè)工作表，分別為《抽獎(jiǎng)頁面》和《名單維護(hù)》頁面。將待抽獎(jiǎng)名單放在《名單維護(hù)》頁的A列，其中A1單元格為標(biāo)題

第二步：編寫代碼

• 點(diǎn)擊開發(fā)工具-Visual Basic, 或按下快捷鍵 ALT + F11 啟動(dòng) Visual Basic for Applications 窗口
• 在“插入” 菜單上，單擊“模塊”
• 在出現(xiàn)的模塊1代碼窗口中，復(fù)制并粘貼以下代碼：

#If VBA7 Then

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

#Else

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

#End If

Dim mark As Boolean

Sub 立即開始()

mark = True

Do While mark

DoEvents

Sleep 100

抽獎(jiǎng)

Loop

End Sub

Sub 停止抽獎(jiǎng)()

mark = False

End Sub

Sub 抽獎(jiǎng)()

Dim M&, N&, i&, j&, arr

Dim d As Object

Set d = CreateObject(";)

arr = S("A2:A" & S("A65536").End(xlUp).Row)

Range("B4:B65536").ClearContents

M = Range("D4")

N = UBound(arr)

If N < M Then MsgBox "人數(shù)超出" & N: Exit Sub

Do While i < M

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

If Not d.exists(j) Then

i = i + 1

d(j) = arr(j, 1)

End If

Loop

Range("B4").Resize, 1) = A)

End Sub

寫入代碼

第三步：插入命令按鈕

• 通過開發(fā)工具——插入——Active控件，插入一個(gè)命令按鈕
• 雙擊這個(gè)命令按鈕，輸入過程名“立即開始”，并將這個(gè)按鈕的caption屬性改為“開始”
• 重復(fù)以上步驟再插入一個(gè)命令按鍵，輸入過程名“停止抽獎(jiǎng)”，并將這個(gè)按鈕的caption屬性改為“停止”

插入命令按鈕

第四步：名單演示美化

• 利用條件格式設(shè)置名單的填充色和字體顏色
• 利用公式確定要設(shè)置格式的單元格：=B1<>""

設(shè)置格式

總結(jié)：

這個(gè)小工具的核心是：利用了字典+數(shù)組實(shí)現(xiàn)了名單的隨機(jī)不重復(fù)抽取。

如果你也有類似的需求，可以關(guān)注本頭條號(hào)：千萬別學(xué)Excel，并私信回復(fù)：小工具 即可獲取本教程所用課件。

圖文教程創(chuàng)作不易，請(qǐng)點(diǎn)贊、關(guān)注并轉(zhuǎn)發(fā)給更多有需求的小伙伴們吧！

送人玫瑰，手有余香！