昨天快到中午的時候接到業務部門的一個需求,要求對現有的抽獎軟件進行改進。
問題是:現在的抽獎軟件每次只能夠抽出一個中獎號碼,而此次設置的各種獎項的中獎人數加起來有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之類的工具中才能夠編寫出軟件,呵呵。
此次的經驗對自己來說也很有用,拿出來和大家一起分享。