超級簡單的抽獎工具

昨天快到中午的時候接到業務部門的一個需求，要求對現有的抽獎軟件進行改進。

問題是：現在的抽獎軟件每次只能夠抽出一個中獎號碼，而此次設置的各種獎項的中獎人數加起來有500人，如果使用原有的軟件，就意味著需要點擊500次，然後記錄500次，工作量很大，也比較容易出錯。

時間要求的非常緊，只有一個下午，第二天也就是今天就要開始抽獎活動了。

分析了一下，真的是一個緊急的需求，而且還要求將源數據導入到程序中，抽獎完畢，還要將所有中獎的號碼導出到Excel。這樣的話，如果使用 application形式的程序的話，那麼不僅編寫代碼和測試的時間來不及，而且很容易出錯，還需要考慮如何導入導出，還需要為業務人員配置數據庫，等等。

於是，決定采用一種比較投機取巧的方式——直接使用Excel的VBA來編寫。

這樣做的好處很明顯：

1、避免了數據的導入導出

2、可以讓我將精力集中在隨機抽取中獎號碼的邏輯上。

3、生成的數據非常容易處理，可以將其他需要的字段放在抽獎號碼列之外，然後就可以和號碼一起復制、處理了。

抽獎的方式直接使用了VBA中提供的隨機數函數，從所有的抽獎號碼中隨機抽取就可以了。

抓個圖看看：

具體的代碼如下：

'數據源工作簿中的行列
Const　START_ROW_SOURCE　As　Integer　=　2
Const　ID_SOURCE　As　String　=　"B"
Const　RESULT_SOURCE　As　String　=　"C"
'抽獎結果工作簿中的行列
Const　ID_RESULT　As　String　=　"B"
Const　FIRST_CELL_RESULT　As　String　=　"B5"
Const　START_ROW_RESULT　As　Integer　=　5
'數據源最大行
Private　maxRow_Source　As　Integer
'開始抽獎
Private　Sub　cmdDraw_Click()
On　Error　GoTo　ErrorHandler:
　　 '取得當前的中獎等級
　　 Dim　rewardLevel　As　String
　　 rewardLevel　=　txtLevel.Text
　　 '取得得獎的人數
　　 Dim　rewardCount　As　Integer
　　 If　(Trim(txtCount)　<>　"")　Then
　　　　 rewardCount　=　CInt(txtCount.Text)
　　 Else
　　　　 MsgBox　("請輸入中獎人數！")
　　 End　If
　　 maxRow_Source　=　getMaxRow(shtDataSource)
　　 '清除當前結果
　　 Dim　maxRow_result　As　Integer
　　 maxRow_result　=　getMaxRow(shtDrawResult)
　　 If　(maxRow_result　>　START_ROW_RESULT)　Then
　　　　 shtDrawResult.Range(FIRST_CELL_RESULT,　shtDrawResult.Cells.SpecialCells(xlCellTypeLastCell)).Value　=　""
　　 End　If
　　 '已經抽出的數量
　　 Dim　drewCount　As　Integer
　　 drewCount　=　0
　　 Dim　curResultRow　As　Integer
　　 curResultRow　=　START_ROW_RESULT
　　 Dim　randomRow　As　Integer
　　 Dim　currentID　As　String
　　 Dim　currentRewardStatus　As　String
　　 '循環抽出指定數量的中獎憑證
　　 While　(drewCount　<　rewardCount)
　　　　 '取得一個隨機數
　　　　 randomRow　=　(maxRow_Source　-　START_ROW_SOURCE　+　1)　*　Rnd　+　START_ROW_SOURCE
　　　　 '該行數據即為被抽中
　　　　 currentID　=　shtDataSource.Range(ID_SOURCE　&　CStr(randomRow)).Cells.Value
　　　　 If　Trim(currentID)　<>　""　Then
　　　　　　 '檢查該憑證是否已經被抽過獎
　　　　　　 currentRewardStatus　=　shtDataSource.Range(RESULT_SOURCE　&　CStr(randomRow)).Cells.Value
　　　　　　 If　Trim(currentRewardStatus)　=　""　Then
　　　　　　　　 '復制到抽獎結果中來
　　　　　　　　 shtDataSource.Range(ID_SOURCE　&　CStr(randomRow)).Copy
　　　　　　　　 shtDrawResult.Range(ID_RESULT　&　CStr(curResultRow)).PasteSpecial　(xlPasteAll)
　　　　　　　　 '設置數據源中的中獎欄位
　　　　　　　　 shtDataSource.Range(RESULT_SOURCE　&　CStr(randomRow)).Cells.Value　=　rewardLevel
　　　　　　　　 curResultRow　=　curResultRow　+　1
　　　　　　 End　If
　　　　 End　If
　　　　 drewCount　=　drewCount　+　1
　　 Wend
　　 GoTo　ExitHandler
ErrorHandler:
　　 MsgBox　("出現問題！")
　　 Exit　Sub
ExitHandler:
　　 MsgBox　("完成！")
End　Sub

'取得工作簿的最大行
Function　getMaxRow(sht　As　Worksheet)　As　Integer
　　 Dim　lastCell　As　Range
　　 Set　lastCell　=　sht.Cells.SpecialCells(xlCellTypeLastCell)
　　 getMaxRow　=　lastCell.Row
End　Function

編寫完了之後，看看時間，只用了不到兩個小時，而且和業務人員說明了一下，完全滿足需要，哈哈。

總結一下：對於業務部門提出的需求，開發工具的選擇其實很重要，因為那不僅能夠節省很多開發工作，節省時間，還能夠降低業務人員的學習曲線，畢竟對於他們來說，學習一個沒有用過的程序和學習如何使用Excel相比，還是有些難度的。另外就是，程序無處不在，不能認為只有在Eclipse、VS之類的工具中才能夠編寫出軟件，呵呵。

此次的經驗對自己來說也很有用，拿出來和大家一起分享。