前几天写了个用excel实现一个简单的抽奖系统,阅读量惨淡。
本来想写成一个系列,第一篇仅仅使用excel公式,然后逐步使用VBA深入,最终形成一个比较完善的抽奖系统。
快过年了,年会用的抽奖系统,用excel实现真简单(一)
在第一篇中,因为仅仅使用了几个公式,所以功能上来说很不完善,甚至说是简陋。这个是没办法的,因为面向的是没有任何excel基础的人来写的。比如要抽10个人中奖,那么就有可能抽到重复的人员,如果哪个员工有主角光环、运气逆天,甚至可能10次都抽到他。
下面,我们使用VBA,来实现去重的功能。也就是说,可以同时在公司员工名单里,抽取10个人,保证同一个人不会被重复抽到,同时实现保存中奖名单的功能。
下面正式开始。
准备员工工号和名单
在上一篇中,我们准备了几百人的员工名单,这次直接拿来用。如果没有名单的,可以参考
职场中需要大量人员信息测试?python几分钟帮你解决
一文,本文所使用的名单,完全是用程序随机产生,如有雷同,纯属巧合。
我们准备的名单如上图,该sheet页名字改为人员名单设定。为了防止姓名有重复的,前面加上工号这一列,这样抽奖的时候,会同时显示工号和姓名,防止了重名的现象。如果单位没有工号,那么可以如图一样给编制一个工号,在抽奖前,可以将该名单向全体员工公示。
从N个数中,抽取不重复的M个数的方法
比如公司有100个员工,我们抽取其中的30个作为中奖用户。
Function 不重复随机数(totalPeople, sumOfWinner) Dim arr(), i, d, x i = 0 Set d = CreateObject("scripting.dictionary") Randomize ReDim arr(sumOfWinner - 1) Do While i < sumOfWinner x = Int((Rnd * totalPeople) + 1) If Not d.exists(x) Then d(x) = "" '加入字典,防止重复 arr(i) = x i = i + 1 End If Loop 不重复随机数 = arrEnd Function
这里totalPeople就是公司的总员工数量,sumOfWinner就是中奖人员数量,调用该函数的时候,传入相应的参数,就能在N个员工中抽取M个中奖人员。
这里主要使用了dictionary,dictionary是一种数据结构,在抽奖的时候,随即从所有员工中抽取一个,放入dictionary中保存,如果下次再抽到这名员工,那么dictionary中已经有了,就可以把该名员工第二次抽取给放弃掉,然后继续随机抽取,一直到抽取了M名不重复的员工。
获取员工总人数,以及设定需要中奖人数
每个公司的员工人数是不同的,每次抽奖的人数也是不同的。
将全体员工的工号和姓名放入到人员名单设定的sheet中,然后使用
Sheets("人员名单设定").Cells(Rows.Count, 1).End(xlUp).Row
就可以获取到第一列的最后一行数据,这样就能知道参与抽奖的总人数。
在我们的抽奖页面,设定一个抽奖人数,比如如果需要抽取10个人,那么这里填写10,然后在vba代码里,使用
Sheets("抽奖").Range("I4")
就可以获取需要中奖的人数。
开始抽奖
点击抽奖页面的“开始抽奖”按钮后,执行下述代码:
Sub 开始抽奖_Click() Dim gonghao(), xingming() Dim totalPeople As Integer, sumOfWinner As Integer Dim b As Variant Sheets("抽奖").Range("B4:D1000").ClearContents sumOfWinner = Sheets("抽奖").Range("I4") totalPeople = Sheets("人员名单设定").Cells(Rows.Count, 1).End(xlUp).Row ReDim gonghao(sumOfWinner) ReDim xingming(sumOfWinner) b = 不重复随机数(totalPeople, sumOfWinner) For i = 0 To UBound(b) gonghao(i) = Sheets("人员名单设定").Cells(b(i), 1) xingming(i) = Sheets("人员名单设定").Cells(b(i), 2) Next i Sheets("抽奖").Range("B4").Resize(sumOfWinner) = Application.Transpose(b) Sheets("抽奖").Range("D4").Resize(sumOfWinner) = Application.Transpose(xingming) Sheets("抽奖").Range("C4").Resize(sumOfWinner) = Application.Transpose(gonghao) End Sub
首先获取到公司的总人数、需要抽取的中奖人数,然后根据第一步所描述的,比如公司员工100个,需要抽取25个,那么调用函数
不重复随机数(100,25)
这样就能从1-100之间,随机抽取25个不重复的数字。然后去人员名单设定sheet页,根据这25个数字,查找该行的人员工号和姓名,将工号和姓名显示在抽奖sheet页。
大家可以看到,输入需要中奖人数,就会随机产生相应数量的中奖人员信息。
保存中奖结果和清空中奖结果
新建一个sheet页,命名为“中奖人员名单”。
点击抽奖页面的“保存中奖名单”按钮时,执行如下代码:
Sub 保存抽奖结果_click() Call 清空中奖名单_click Dim i, j As Integer i = Sheets("抽奖").Cells(Rows.Count, 2).End(xlUp).Row 'j = Sheets("中奖人员名单").Cells(Rows.Count, 1).End(xlUp).Row Sheets("抽奖").Range("b3:d" & i).Copy Sheets("中奖人员名单").Range("A1") End Sub
代码解释:首先清空“中奖人员名单”sheet页。获取到中奖名单的最后一行,然后从随机码、工号、姓名这一行,将所有的中奖人员名单,复制到“中奖人员名单”sheet页的A1单元格。
点击抽奖页面的“清空中奖名单”按钮时,执行如下代码:
Sub 清空中奖名单_click() Sheets("中奖人员名单").Range("A:C").ClearContentsEnd Sub
即将该sheet页的A、B、C列内容全部清空。
总结
好了,以上就是整个抽奖的逻辑和全部的代码了。
这个代码还有几处需要注意的地方:
- 如果中奖人员比例太高,会很慢。比如从100个人里抽取99个人,因为每次都是随机抽取其中一人,然后去比对是否已经抽到了,越是到最后,那么重复的概率就会越大,所以会一直的随机抽取,效率很低。所以如果遇到这种情况,不妨变通一下,抽取一个人不中奖,没抽取到的全部中奖。
- 如果需要多次抽奖, 那么需要将每次中奖结果单独复制出来。比如先抽取三等奖,抽完后需要将三等奖中奖结果复制出来。然后再抽二等奖,再复制出来。
总之,一个比较完善的抽奖系统就是这样了。至少比第一个完善很多。