超级简单的抽奖工具

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

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

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

p.s. 本想把Excel文件也放到这里，但是不知道怎么放附件，如果哪位知道告诉我一下，我直接把那个文件也共享出来。

具体的代码如下：