最新年会活动娱乐Excel幸运抽奖系统excel模板最新

【原创】ExcelVBA实现不重复、多次抽奖⼩程序在活动中，我们常会有抽奖，抽奖箱准备繁琐，现在多采⽤线上抽奖⽅式，下⾯⽤Excel VBA写了⼀个简单的抽奖⼩程序简单测试效果如下，可实现：多次抽奖，且每次抽奖都不重复抽奖界⾯滚动⼈员信息，点击抽奖按钮锁定中奖⼈员中奖⼈员信息在右侧公⽰区域展⽰，最新中奖⼈员展⽰在最上⽅设置了⼀部分误点、误操作提⽰，以及抽奖完成提⽰等已优化，⽀持万⼈级抽奖做了⼀个抽奖简单演⽰，演⽰GIF如下：实现代码如下，按需⾃取，转载请备注出处：'申明Flag、d、e三个模块变量，跨进程引⽤，实现滚动和抽奖数据传递Dim Flag As Boolean '屏幕停⽌滚动并抽奖的判断参数Dim d As Object '将随机抽取的中奖⼈员按⾃增键储存Dim e As Object '将随机抽取的中奖⼈员按原键储存Dim dict_id As Object '本轮参与抽奖⼈员⼯号Sub 重置()'清空上次抽奖内容，将⼈员名单复制到辅助列Application.ScreenUpdating = False '屏幕刷新禁⽤，不展⽰清空数据过程Sheets("抽奖界⾯").SelectSheets("抽奖界⾯").Range("E2") = 0Sheets("抽奖界⾯").Range(Range("B6"), Range("F15")).ClearContentsSheets("抽奖界⾯").Range(Range("J3"), Range("P3").End(xlDown)).ClearContentsSheets("⼈员名单").SelectSheets("⼈员名单").Range(Range("H3"), Range("H3").End(xlDown)).ClearContentsSheets("⼈员名单").Range(Range("A3"), Range("A3").End(xlDown)).Copy _Sheets("⼈员名单").Range("H3")Sheets("抽奖界⾯").SelectApplication.ScreenUpdating = True '屏幕刷新开启，为滚动抽奖做准备End SubSub 准备() '准备开始抽奖，灰⾊区域滚动更新中奖⼈员Set d = NothingSet e = NothingSet dict_id = NothingFlag = Truetext_level = Sheets("抽奖界⾯").Range("A2") '抽取奖项lottery_target = Sheets("抽奖界⾯").Range("D2") '抽奖次数⽬标'判断该奖项是否已经抽取过，当变更了抽取奖项时，⾃动重置已抽取次数为0If Application.WorksheetFunction.CountIfs(Sheets("抽奖界⾯").Range("J:J"), _text_level) = 0 ThenSheets("抽奖界⾯").Range("E2") = 0End If'判断剩余参与⼈数是否⾜够抽奖If Sheets("抽奖界⾯").Range("F2") < Sheets("抽奖界⾯").Range("C2") ThenMsgBox ("剩余参与⼈数不⾜，请修改抽奖参数或停⽌抽奖")Exit SubEnd If'判断该奖项是否已抽取完，提⽰操作⼈员是选择加抽还是变更抽奖奖项If Sheets("抽奖界⾯").Range("E2") >= lottery_target ThenQS_Return = MsgBox(text_level & "抽奖" & lottery_act & "已完成！" & _Chr(10) & "要变更奖项请选择是" & Chr(10) & "要再次抽取" & text_level & _"请选择否", vbYesNo + vbQuestion, "提⽰")If QS_Return = vbYes ThenMsgBox (text_level & "请重新选择奖项，输⼊抽奖次数和单次抽奖⼈数！")Exit SubElseSheets("抽奖界⾯").Range("D2") = Sheets("抽奖界⾯").Range("D2") + _Sheets("抽奖界⾯").Range("E2")End IfEnd If'清空抽奖滚动区域Sheets("抽奖界⾯").Range(Range("B6"), Range("F15")).ClearContentsnum_agent = Sheets("抽奖界⾯").Range("F2")'字典赋值Set dict_id = CreateObject("Scripting.Dictionary")For i = 1 To num_agentdict_id(i) = Sheets("⼈员名单").Cells(i + 2, 8)Nextnum = Sheets("抽奖界⾯").Range("C2")'持续滚动抽奖界⾯，等待点击抽奖后停⽌DoSet d = CreateObject("Scripting.Dictionary")Set e = CreateObject("Scripting.Dictionary")For j = 1 To numDoa = Int(Rnd * num_agent) + 1Loop Until Not e.Exists(a)d(j) = dict_id(a)e(a) = dict_id(a)NextFor m = 1 To 10For n = 1 To 5If n + (m - 1) * 5 > num ThenExit ForElseSheets("抽奖界⾯").Cells(m + 5, n + 1) = d(n + (m - 1) * 5)DoEvents '将控制权传给操作系统，实现滚动的同时可以点击抽奖按钮，⾮常关键 End IfNextNextLoop Until Flag = FalseEnd SubSub 抽奖()If Not Flag ThenMsgBox ("请先点击准备按钮，再开始抽奖")Exit SubEnd IfFlag = False '停⽌抽奖滚动，中奖⼈员确定Set f = CreateObject("Scripting.Dictionary")text_level = Sheets("抽奖界⾯").Range("A2")Sheets("抽奖界⾯").Range("E2") = Sheets("抽奖界⾯").Range("E2") + 1 '已抽取次数+1lottery_act = Sheets("抽奖界⾯").Range("E2") '已抽取次数，后⾯需要判断是否提⽰抽奖完成num = Application.WorksheetFunction.CountA(Sheets("抽奖界⾯").Range("B6:F15"))num_exist = Sheets("抽奖界⾯").Range("G2")'将新中奖⼈员信息添加⾄公⽰区域末尾For i = 1 To numSheets("抽奖界⾯").Cells(2 + num_exist + i, 10) = text_levelSheets("抽奖界⾯").Cells(2 + num_exist + i, 11) = lottery_actSheets("抽奖界⾯").Cells(2 + num_exist + i, 12) = d(i)Sheets("抽奖界⾯").Cells(2 + num_exist + i, 13) = _Application.WorksheetFunction.VLookup(d(i), Sheets("⼈员名单").Range("A:E"), 2, False)Sheets("抽奖界⾯").Cells(2 + num_exist + i, 14) = _Application.WorksheetFunction.VLookup(d(i), Sheets("⼈员名单").Range("A:E"), 3, False)Sheets("抽奖界⾯").Cells(2 + num_exist + i, 15) = _Application.WorksheetFunction.VLookup(d(i), Sheets("⼈员名单").Range("A:E"), 4, False)Sheets("抽奖界⾯").Cells(2 + num_exist + i, 16) = _Application.WorksheetFunction.VLookup(d(i), Sheets("⼈员名单").Range("A:E"), 5, False)Next'将所有中奖⼈员存放⾄字典For i = 1 To num_exist + numIf i <= num Thenf(i) = Sheets("抽奖界⾯").Range(Cells(num_exist + i + 2, 10), _Cells(num_exist + i + 2, 16))Elsef(i) = Sheets("抽奖界⾯").Range(Cells(i + 2 - num, 10), Cells(i + 2 - num, 16))End IfNextSheets("抽奖界⾯").Range(Cells(3, 10), Cells(num_exist + num + 3, 16)).ClearContentsSheets("抽奖界⾯").[J3].Resize(f.Count, 7).Value = _Application.Transpose(Application.Transpose(f.items))'奖项抽取完成后提⽰⼈员变更参数If lottery_act = Sheets("抽奖界⾯").Range("D2") ThenMsgBox (text_level & "抽取" & lottery_act & "次已完成，请变更抽奖奖项和次数")End If'更新待抽奖⼈员名单，实现不重复抽奖num_agent = Sheets("抽奖界⾯").Range("F2")Application.ScreenUpdating = False '屏幕刷新禁⽤，不展⽰清空数据过程Sheets("⼈员名单").SelectFor Each Key In edict_id.Remove (Key)NextSheets("⼈员名单").Range(Range("H3"), Range("H3").End(xlDown)).ClearContentsSheets("⼈员名单").[H3].Resize(dict_id.Count, 1).Value = _Application.Transpose(dict_id.items)Sheets("抽奖界⾯").SelectApplication.ScreenUpdating = True '屏幕刷新开启，为下⼀轮滚动抽奖做准备End Sub功能实现思路：通过随机函数Rnd产⽣[0,1)的随机数，再乘以当前参与⼈数放⼤，实现随机抽奖通过字典的Exists⽅法判断是否重复，实现去重抽奖定义模块变量，实现⼈员滚动和抽奖的分离DoEvents语句将控制权传给操作系统，实现滚动的同时可以点击抽奖按钮，是实现抽奖屏幕滚动更新的关键最初以遍历的⽅式回填数据，发现参与⼈数上万时明显卡顿，改⽤字典的items⽅法回填数据（⼀维数据回填到列：Application.Transpose(dict.items)，⼆维数据回填到列：Application.Transpose(Application.Transpose(dict.items))）。

•excel软件1.打开excel，建立两个表格，分别命名为【员工花名册】和【中奖名单】，分两个表格只是为了抽奖时放大效果。

当然，你也可以只在一个表格上操作。

2.在【员工花名册】表格中，空白处输入公式【=rand()】。

3.接着按【回车/enter】，就能看到一个随机数值，下拉填充与员工数量对等。

4.打开另一个子表格【中奖名单】，选择一个空白格，输入公式：=INDEX(员工花名册!C$3:C$22,RANK(员工花名册!E3,员工花名册!E$3:E$22))5.接着按【回车/enter】，就能看到一个随机员工名字，中奖几个人，就下拉填充几行。

6.公式设置结束后，可根据自己喜好，对抽奖版面进行修饰。

7.最后，抽奖时，长按【F9】，让名单滚动，停下时，即可选出中奖名单。

END•运用到的函数分别有rand、rank、index•注意数据的绝对值手把手教你制作Excel抽奖器2014-11-15 作者:ExcelHome 阅读:154612次三国公司开年会，现场举行一次抽奖环节，要从50个人中，抽取10个幸运者，要求每个姓名只能出现一次。

职工名单如下图所示：在Excel中制作随机抽奖的效果，核心是生成一组随机不重复值。

首先，在B4输入以下公式，向下复制至B53：= RAND()RAND函数的作用是生成介于 0 到 1 之间的随机数（变量）。

******************D4单元格输入以下公式，向下复制：=INDEX(A$4:A$53,RANK(B4,B$4:B$53))简单说一下公式的意思：RANK(B4,B$4:B$53)RANK函数对B4:B53单元格产生的随机数字排序，生成了随机的1-50的数字。

RANK函数的计算结果将用于INDEX函数的参数。

INDEX函数返回表格(B4:B53)中的元素值，此元素由行号的索引值(也就是RANK 函数的运算结果)给定。

因为B列的数字是完全随机的，所以任何数字出现在前10行的概率都相同。

[X]等奖-本次获奖名单
开始抽奖打印获奖名单
使用说明及注意事项：【使用模板前需要先把该模板以et或xls格式保存到本地，然后在打开】
1. 本抽奖程序可以根据用户设置对一组候选名单进行抽奖。

2. 请在《候选名单》工作表中录入所有候选项。

请连续纵向输入，不留空行。

3. 最多可设置六个级别的奖项。

4. 单项最多可设 5000 名获奖者，获奖者总数不能多于候选人数。

5. 抽奖顺序有两种，即先小奖后大奖或相反。

6. 抽奖方法分为两种：每次抽取一组中的全部获奖者，或每次抽取若干名同一组获奖者。

7. 抽奖一旦开始，请完成整个抽奖过程，不要中途退出程序。

8. 本程序不支持重复获奖。

说明：
本抽奖模板仅用于娱乐目的！
模板作者对抽奖过程、抽奖结果及模板本身的工作状况不作任何承诺!
模板作者对所有因使用本模板而产生的疑问、纠纷或其他问题不承担任何责任！。

软件使用说明：(工程密码：excelhome)【前言部分】本软件程序的宗旨是——为用户提供更多个性化支持！做软件开发就好像是厨师做菜，客人按照现有菜单点了一道菜，厨师就按照自己的特色和经验开始烹制，菜烧好装盘上桌，客人吃完埋单走人。

有些情况下也会有客人觉得菜做得不够满意，要求返工甚至退单。

出色的大厨都比较有个性，对自己的手艺和味觉具有相当高的自信，很少会根据一般食客的意见来改变自己原有的烹饪方法。

一般食客也很少有可能越俎代庖，依据自身的喜好来量身定做菜式。

而现在，我作为这个抽奖软件程序的掌勺开发者，我希望换一种更新颖的形式来烹饪我的软件——根据客户的个性化需求来进行自助式的烹饪。

需要用什么材料？用的煎煮炒炸蒸哪种手段？油盐放多少？喜欢辣的还是酸的？用什么装盘？摆盘摆成什么造型？。

等等，把这些在菜单上不一定能够找得到的个性化需求全都呈现在客户面前，让他们自己来选择自己合意的方式。

正所谓众口难调，要做一个能让所有人满意的厨师实在是很难，而把选择权交给用户，却能够在很大程度上提高大多数用户的满意度，这就是我的想法和我所想实现的目标。

这个软件从1月12号发布到现在差不多有两个礼拜，期间升级改版了近10次，几乎每一次改版都有新增的个性化选项。

也是因为软件功能不断变化，因此这个软件说明帖一直迟迟没有发布。

从最初版本到现在目前的V1.9版，其功能变化如下图所示：【操作说明部分】主要操作分为三个步骤。

步骤一进行抽奖人员的名单导入。

人员名单需要预先存放在某工作簿的第一个工作表的A列中，名单可以是人员姓名也可以是员工编号或其他信息，如果需要同时显示姓名和编号，可以将两列信息合并成为一列后再行导入。

在考虑到页面布局美观的因素下，程序中设定可以显示完整的名单字符长度大约为4～5个字符（根据字体样式选择有所不同）。

如果需要支持超长字符，可以在153楼下载特殊定制版使用，那个版本不会再继续更新。

在准备好人员名单之后，点击下图中【导入名单路径】区域的【浏览】按钮，即可在文件路径中选择包含名单的Excel工作簿文件（支持Excel2000、2003、2007和2010），如果名单中的第一行是标题行（不包含人员姓名），则需要同时勾选下方的“包含标题行”复选框。

吴明翔张光毕王风亭吴才伦杨胜义李江敏杨海杨华琴王国秀闵卫琴宋国荣罗会变张金艳杨华忠雷本兴许乾力赵书君魏吉元王建华阮岳马仕开秦永琴丰帮益石尚华杨再品蒲生周蒋海江杨昌美彭应素龙继梅杨再芬宋国爱韦应刚杨昌线廖德成韦仕勇梁龙彪刘兴江杨胜宽秦霞任明秋龙胜潘颖吴兴珍刘年专杨忠英補国献安成事岑仕建张洪英
杨小现乔佳丽吴斌张益唐丽吴江琴安明勇李秀凤韦应昌韦堂开雷小浪杨秀昌龙明义郑阳帅杨跤陈荣才安明权杨胜坤王云伍倩贺茂会张明琴班小芬曾流香陆春情韦朝光李贵发张贵川伍建开常兴亮杨巧杨秀江曾流巧。

500元的奖金就这样没了！o(╥﹏╥)o（Excel教程-抽奖程序）
五一将近，
店里活动好多呢，
九九忙得要趴下了。

o(╥﹏╥)o
不过~~
再忙也觉得高兴，
(〃'▽'〃)
老板今天很霸气的，
每人发了300元的节日慰问金呢，
(＾－＾)V
而且，
还有一个500大洋的特别将，
说是要让我通过抽奖的方式，
确定获奖人。

考虑了一下准备时间，
我决定用Excel弄个抽奖程序，
然后在店铺的电视上播放抽奖过程，
(〃'▽'〃)
操作步骤：
1.建立抽奖表格
2.在B3的位置输入公式=RANDBETWEEN(1,5)，该公式表示在1~5的范围
内，随机抽取一个整数
店铺里，
包括我在内，
总共5个人，
大家领好各自编号后，
抽奖准备开始啦，
♪(^∇^*)
我按着键盘上的F9键不放，
Excel上的获奖编号不断闪烁，
为什么按F9？
因为Excel中F9是刷新的快捷键
放开F9，
就会显示出获奖编号，
大家猜猜会是谁获奖？
肯定是我啊，
(＾－＾)V
当然，伟大如我，
我把500大洋贡献了出来，今晚和大家去了宵夜。

我是心甘情愿贡献出来的，不是因为下面的人，
大叫贪污才拿出来的，
真的，你一定要信。

500大洋就这样没了
o(╥﹏╥)o。

excel教程年终抽奖必备运用2个函数随机抽取姓名
在前面的课程，我们讲解了运用Excel制作掷骰子游戏，有的小伙伴就在问，可不可以用Excel随机抽取姓名用来抽奖，或者随机出现菜名，来帮助选择困难症的小伙伴，答案是可以的，下面，我们就以随机抽取姓名为例。

1、在A列输入好姓名，B1单元格写好标题，设置好格式（也可以不写，根据具体情况）2、选中B2单元格，输入公式
=INDIRECT('A'&RANDBETWEEN(2,10))其中，A为姓名列的列号，2为姓名开始行，10为姓名结束行3、再修改B2
单元格的样式，并隐藏网格线4、如果不想显示人名，可以选中A列，把名字颜色改为白色5、现在，想要随机出现姓名，只需要按【F9】，每按1次，随机出现1个姓名相关推荐如何用Excel制作1款小游戏？年终必备，掷骰子游戏，建议收藏！~●请大家多多关注、点赞、评论，让我有动力继续更新更多教程●。

手把手教你用excel做一套电脑派位摇号系统首先说下这套电脑摇号派位的原理，一共分四步，第一步首先将需要摇号派位的学生信息收集完整，按照报名序号、姓名、性别及家长信息等原始信息放入一个excel表中。

第二步，给每个学生生成一个随机号，这个随机号是电脑随机生成，每个学生不同。

第三步，通过掷硬币或者找家长抽签的方式，确定录取的方式，是从大号到小号录取，还是从小号到大号录取，第四步，按照抽签确定的顺序排序录取一定数量的学生，到此录取全部完成。

之所以用excel来做，就是因为excel的VBA实现排序的功能很方便，源码所见所得，容易查询，也很容易公开查询。

下面来一点点的实现。

一、软件打开动画首先打开excel，打开VBA，插入一个窗体，设置5秒倒计时消失。

核心代码如下：Private Sub UserForm_Initialize()ltime.Caption = 5Call bEnd Sub二、主窗体设计基本功能都在此界面内完成，其实也简单，就是使用excel 表格的大部分功能，然后右侧加入需要的功能按钮。

这里为了更加公平，加入了两次生成随机数，两次排序，杜绝作弊。

大家看下右侧的按钮，我们一点点来做。

1.首先来做第一个查询窗口，点击查询记录，会跳出一个查询。

代码如下：Sub 查询()UserForm1.ShowEnd Sub在VBA中添加窗体，窗体中加入各控件，给查询按钮加入事件：Private Sub CommandButton1_Click() '查询Dim MYRANGE As RangeDim i As IntegerSet MYRANGE = Sheets("SHEET1").Range("a2", Range("A65536").End(xlUp)).Find(TextBox10.Value) '在excel中查找相同的数据If Not MYRANGE Is Nothing ThenFor i = 1 To 8Me.Controls("TEXTBOX" & i) = Cells(MYRANGE.Row, i) Next iElseMsgBox "没有找到！" & TextBox10End IfEnd Sub2.做第一个随机数生成给图中按钮加入事件代码：Sub 随机号生成()'生成8位的不相同的随机数Dim i As Long, t0, dict, key As Long, key_count As LongDim low As Long, high As Long, diff As Long, count As Long, try As Currencyt0 = Timer[f2:f501].Clear '清空low = 10000000high = 99999999count = 291try = 100 * countIf high < low Then high = low: low = 1diff = high - lowIf diff <= count Then count = diff + 1Set dict = CreateObject("Scripting.Dictionary")ReDim arr(1 To count, 1 To 1)RandomizeFor i = 1 To trykey = Round(Rnd * diff + low, 0)If Not dict.exists(key) Thenkey_count = key_count + 1arr(key_count, 1) = keydict.Add key, ""Else'do nothingEnd IfIf key_count >= count Then Exit ForNext iRange("f2:f" & count + 1).Value = arrMsgBox "生成随机号完成"End Sub3.按照生成的随机数排序，抽签或者掷硬币确定排序顺序。

一起制作Excel版简易抽奖器
话说某公司开年会，现场举行一次抽奖环节，要从50个人中抽取10个幸运者，要求每个姓名只能出现一次。

职工名单如下图所示：在Excel中制作随机抽奖的效果，核心是生成一组随机不重复值。

首先在B2输入以下公式，向下复制至B51单元格：
=RAND()
RAND函数的作用是生成介于 0 到 1 之间的随机数。

接下来在D2单元格输入以下公式，向下复制到D11：=INDEX(A$2:A$51,RANK(B2,B$2:B$51))
简单说一下公式的意思：先来看这部分：RANK(B2,B$2:B$51)RANK函数对B2:B51单元格产生的随机数字排序，相当于生成了随机的1-50的数字。

INDEX函数的作用是根据指定的位置信息，返回某个单元格区域中对应位置的内容，本例中的位置信息就是RANK函数的运算结果。

因为B列的数字是完全随机的，所以任何数字出现在前10行的概率都相同。

好了，接下来按住F9键不放，就可以进入激动人心的抽奖环节了：
注意，抽奖结果生成后不能再进行编辑公式或是双击等激发重新计算的动作，否则抽奖结果会发生变化。

作者：cleverzhzhf。