文/江覓易見
公司年會，為了活躍氣氛，基本上都有一個抽獎環節，為了顯示相對的公平公正，一般通過隨機的方式來取得人員名單。就像黑箱摸人一樣，看上去不被人知道的事情，就應該是公平的一樣。
事實上也是如此，對於辛苦一年之後，給大家找點快樂，也不能浪費了公司的一片好意。
如何讓這樣的好意不被誤解為暗箱操作，那麼就用聽天由命來解決吧！
這是一個隨機獲取人員名單的功能，分別可以抽取一二三等獎共六人。當然了，如果你懂vba，也可以增加很多人。
效果
代碼
這裡用了兩個函數 ，一個開始抽獎start()，一個停止stops()。Sub start()Dim rng As RangeSet dic = CreateObject("scripting.dictionary")n = 0Num_0 = Worksheets("names").Range("B1").End(xlDown).Row() '取總人數For i = 2 To Num_0If Application.WorksheetFunction.CountIf(Range("D3:I11"), i) = 0 Thenn = n + 1dic(n) = iEnd IfNextflag = TrueDoDoEvents 'DoEvents 語句允許其它事件發生，包括第二次按此按鈕。If flag Then'Cells(1, 1) = dic(Int(Rnd * dic.Count + 1)) '數字顯示語句Cells(1, 1) = Worksheets("names").Cells(dic(Int(Rnd * dic.Count) + 1), 2)End IfLoop While flagEnd Sub
Sub stops()flag = FalseFor o = 1 To 6If Thisname(o) = Cells(1, 1).Value ThenMsgBox Thisname(o) & "雙中獎了！！！"nx = TrueExit ForEnd IfIf Thisname(o) = "" ThenThisname(o) = Cells(1, 1).Value'MsgBox Thisname(o) & "中獎了！"nx = FalseExit ForEnd IfNextFor i = 3 To 11For j = 9 To 4 Step -1 '倒序添加中獎名單If Cells(i, j) = "" ThenIf nx = False ThenCells(i, j) = Cells(1, 1): Exit For '列出中獎名單，退出循環End IfEnd IfNextNextEnd Sub
其真實過程就是在名單工作薄內循環遍歷名字，按停止就提取出當前遍歷的單元格值，也就是名字內容，然後顯示出來，就這麼簡單。
其主要代碼是 CreateObject("scripting.dictionary")，這是一個建立字典對象方法，應用字典模型Key,index值來隨機遍歷字典裡的值。