zoukankan      html  css  js  c++  java
  • 超级简单的抽奖工具

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

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

  • 相关阅读:
    jquery 实现 html5 placeholder 兼容password密码框
    php返回json的结果
    使用PHP读取远程文件
    Sharepoint 自定义字段
    Sharepoint 中新增 aspx页面,并在页面中新增web part
    【转】Sharepoint 2010 配置我的站点及BLOG
    JS 实现 Div 向上浮动
    UserProfile同步配置
    【转】Import User Profile Photos from Active Directory into SharePoint 2010
    Sharepoint 2010 SP1升级后 FIMSynchronizationService 服务无法开启
  • 原文地址:https://www.cnblogs.com/houbowei/p/1658035.html
Copyright © 2011-2022 走看看