超级简单的抽奖工具

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

问题是:现在的抽奖软件每次只能够抽出一个中奖号码,而此次设置的各种奖项的中奖人数加起来有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文件也放到这里,但是不知道怎么放附件,如果哪位知道告诉我一下,我直接把那个文件也共享出来。

原文地址:https://www.cnblogs.com/houbowei/p/1658035.html