超级简单的抽奖工具

昨天快到中午的时候接到业务部门的一个需求，要求对现有的抽奖软件进行改进。

问题是：现在的抽奖软件每次只能够抽出一个中奖号码，而此次设置的各种奖项的中奖人数加起来有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之类的工具中才能够编写出软件，呵呵。

此次的经验对自己来说也很有用，拿出来和大家一起分享。