用EXCEL VBA编写模拟器可以避免误操作导致的数据刷新

*实例*

抽奖编号：5位

在前文《EXCEL RAND、RANK、INDEX函数搞定年会抽奖器》，笔者利用EXCEL的函数制作了简单的模拟随机抽奖器。

该方法，具有明显的缺陷，就是“误操作会导致数据刷新”，本文使用Excel VBA进行简单模拟器编写：

更好地避免“误操作导致的数据刷新”

准确记录已经中奖的名单

支持10000条以内的“抽奖编号”数据添加

缺陷：抽奖编号只支持3-5位数，其它不能自适应，需修改代码

步骤一：界面设计

单元格B：C区域，输入“抽奖编号”数据，并为其分配自增的不重复编号（1-10003）

单元格E3：I3区域，为摇奖过程展示区域，点击【开始】按钮后，E3：I3区域会持续闪烁，点击【结束】，E3：I3停下，并将摇奖结果复制到L列

单元格L列，为【结束】后保存之前的摇奖结果，点击【重置】按钮，将清除E3：I3摇奖区域和L列的数据

步骤二：EXCEL VBA代码

===============开始================

Dim rollID() As String        '设定动态抽奖编号数组

Dim isScroll As Boolean    '设定控制结束的布尔值

Sub rollReward()

'为动态数组确定大小

Dim a As Integer

a = Application.WorksheetFunction.Max(Range("B3:B10003").Value)

'最多在B列支持10000条数据（年会抽奖，每次抽1人，足够了）

ReDim rollID(1 To a)

'为抽奖编号赋值

Dim i As Integer

For i = 1 To a Step 1

rollID(i) = Cells(2 + i, 3)

Next i

Randomize  '初始化随机数生成器

Dim j As Integer

j = Int(Rnd() * a + 1)

isScroll = False  '初始化“控制结束”标记为false

Dim rollstr As String

rollstr = rollID(j)

Range("E3").Value = Mid(rollstr, 1, 1) '抽奖编号第1位数组，填充在E3单元格

Range("E3").Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '随机填充颜色

Range("F3").Value = Mid(rollstr, 2, 1) '抽奖编号第2位数组，填充在F3单元格

Range("G3").Value = Mid(rollstr, 3, 1) '抽奖编号第3位数组，填充在G3单元格

Range("G3").Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '随机填充颜色

If Len(rollstr) >= 4 Then

Range("H3").Value = Mid(rollstr, 4, 1) '抽奖编号第4位数组，填充在H3单元格

End If

If Len(rollstr) >= 5 Then

Range("I3").Value = Mid(rollstr, 4, 1) '抽奖编号第4位数组，填充在I3单元格

Range("I3").Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '随机填充颜色

End If

DoEvents '释放程序控制权

Dim b As Integer

b = Range("K1").Value

If isScroll = True Then

b = b + 1

Range("K1").Value = b

Range("K" & b + 2).Value = b

Range("L" & b + 2).Value = rollID(j)

Exit Sub '判断控制结束的标记是否为true，是就跳出sub

End If

Call rollReward '调用程序自身，重新生成新的随机结果

End Sub

Sub gameover()

isScroll = True  '将控制结束的标记置为true

End Sub

'重置摇奖区和结果展示区数据

Sub resetGame()

Range("k1").ClearContents

Range("k3:K10003").ClearContents

Range("L3:L10003").ClearContents

Range("E3:I3").Interior.Color = RGB(255, 255, 255)

Range("E3:I3").Value = ""

End Sub

===============结束================

步骤三：测试3位、4位、3-5位抽奖编号表现

抽奖编号：3位

抽奖编号：4位

抽奖编号：3-5位

*方法局限*

只能支持3-5位抽奖编号

抽奖编号必须与实际参与者一一对应，且无法一次性抽多人

无法排除已经中奖的编号

版权声明：本文内容由网络用户投稿，版权归原作者所有，本站不拥有其著作权，亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容，请联系我们jiasou666@gmail.com 处理，核实后本网站将在24小时内删除侵权内容。