EXCEL中通过VBA宏编写一个简易抽奖小工具
csdh11 2024-12-10 13:11 5 浏览
最近有粉丝在后台向我提了一个工作中的小需求,具体如下:
■ 因为公司要组织一个知识竞赛,其中有一个游戏环节,需要从一组名单中随机选出指定数量的人员参加游戏,并且需要在大屏中滚动名单以增强游戏紧张感。当然最重要的是最终被选中的名单中不能有重复名单出现。她希望能通过Excel来实现这个需求。
需求分析:其实这个需求与抽奖非常类似,我们可以通过Excel的VBA宏功能来编写一个小工具来实现这个需求,说干就干,以下就是最终实现的成品效果:
功能说明:
第1步、名单在sheet2《名单维护》工作表的A列中输入
第2步、设置抽奖人数
第3步、点击开始按钮,名单开始滚动
第4步、点击停止按钮,出现获奖人员名单
制作步骤如下:
第一步:制作表格
- 建立两个工作表,分别为《抽奖页面》和《名单维护》页面。将待抽奖名单放在《名单维护》页的A列,其中A1单元格为标题
第二步:编写代码
- 点击开发工具-Visual Basic, 或按下快捷键 ALT + F11 启动 Visual Basic for Applications 窗口
- 在“插入” 菜单上,单击“模块”
- 在出现的模块1代码窗口中,复制并粘贴以下代码:
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Dim mark As Boolean
Sub 立即开始()
mark = True
Do While mark
DoEvents
Sleep 100
抽奖
Loop
End Sub
Sub 停止抽奖()
mark = False
End Sub
Sub 抽奖()
Dim M&, N&, i&, j&, arr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
arr = Sheet2.Range("A2:A" & Sheet2.Range("A65536").End(xlUp).Row)
Range("B4:B65536").ClearContents
M = Range("D4")
N = UBound(arr)
If N < M Then MsgBox "人数超出" & N: Exit Sub
Do While i < M
j = Int(Rnd() * N + 1)
If Not d.exists(j) Then
i = i + 1
d(j) = arr(j, 1)
End If
Loop
Range("B4").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
第三步:插入命令按钮
- 通过开发工具——插入——Active控件,插入一个命令按钮
- 双击这个命令按钮,输入过程名“立即开始”,并将这个按钮的caption属性改为“开始”
- 重复以上步骤再插入一个命令按键,输入过程名“停止抽奖”,并将这个按钮的caption属性改为“停止”
第四步:名单演示美化
- 利用条件格式设置名单的填充色和字体颜色
- 利用公式确定要设置格式的单元格:=B1<>""
总结:
这个小工具的核心是:利用了字典+数组实现了名单的随机不重复抽取。
如果你也有类似的需求,可以关注本头条号:千万别学Excel,并私信回复:小工具 即可获取本教程所用课件。
图文教程创作不易,请点赞、关注并转发给更多有需求的小伙伴们吧!
送人玫瑰,手有余香!
- 上一篇:在windows里安装mxnet
- 下一篇:C语言中操作Excel文件的方法与实践
相关推荐
- 如何开发视频会议App? 视频会议 开发
-
过去两年多时间里,视频会议成为职场工作乃至社会常态,在各类场景中得到广泛应用。例如企业会议、培训赋能、远程咨询、产品发布、远程面试等。本案例中的视频会议app来自开发者实战,采用YonBuilder移...
- GB28181学习笔记6 解析invite命令
-
一、信令流程1.实时信令流程点播流程:上级平台向下级发送INVITE请求,请求实时视频下级平台回复200OK上级平台回复ACK确认关闭视频,上级向下级平台发送BYE请求,请求关闭视频下级平台回复20...
- 音视频基础(网络传输): RTMP封包 mp4封装是什么意思
-
RTMP概念与HTTP(超文本传输协议)同样是一个基于TCP的RealTimeMessagingProtocol(实时消息传输协议)。由AdobeSystems公司为Flash...
- python爬取B站视频弹幕分析并制作词云
-
1.分析网页视频地址:www.bilibili.com/video/BV19E…本身博主同时也是一名up主,虽然已经断更好久了,但是不妨碍我爬取弹幕信息来分析呀。这次我选取的是自己唯一的爆款视...
- 实时音视频入门学习:开源工程WebRTC的技术原理和使用浅析
-
本文由ELab技术团队分享,原题“浅谈WebRTC技术原理与应用”,有修订和改动。1、基本介绍...
- 写了一个下载图片和视频的python小工具
-
?谁先掌握了AI,谁就掌握了未来的“权杖”。...
- 用Python爬取B站、腾讯视频、爱奇艺和芒果TV视频弹幕
-
众所周知,弹幕,即在网络上观看视频时弹出的评论性字幕。不知道大家看视频的时候会不会点开弹幕,于我而言,弹幕是视频内容的良好补充,是一个组织良好的评论序列。通过分析弹幕,我们可以快速洞察广大观众对于视频...
- 「视频参数信息检测」如何用代码实现Mediainfo的视频检测功能
-
说明:mediainfo是一款专业的视频参数信息检测工具,软件能够检测视频文件的格式、画面比例、码率、音频流、声道等一系列视频参数信息。若使用代码检测更灵活,扩展性更强,本文介绍使用python+py...
- Python爬虫大佬的万字长文总结,requests与selenium操作合集
-
requests模块前言:通常我们利用Python写一些WEB程序、webAPI部署在服务端,让客户端request,我们作为服务器端response数据;但也可以反主为客利用Python的reque...
- RTC业务中的视频编解码引擎构建 视频编解码简介
-
文/何鸣...
- 深入剖析ffplay.c(14) 深入剖析案例,促进以案为鉴
-
#ifCONFIG_AVFILTERstaticintconfigure_filtergraph(AVFilterGraph*graph,constchar*filtergraph,...
- 一篇文章教会你利用Python网络爬虫抓取百度贴吧评论区图片和视频
-
【一、项目背景】百度贴吧是全球最大的中文交流平台,你是否跟我一样,有时候看到评论区的图片想下载呢?或者看到一段视频想进行下载呢?今天,小编带大家通过搜索关键字来获取评论区的图片和视频。【二、项目目...
- 程序员用 Python 爬取抖音高颜值美女
-
图书+视频+源代码+答疑群,一本书带你入Python作者|星安果本文经授权转载自AirPython(ID:AirPython)目标场景相信大家平时刷抖音短视频的时候,看到颜值高的小姐姐,都有...
- 一周热门
-
-
Boston Dynamics Founder to Attend the 2024 T-EDGE Conference
-
IDC机房服务器托管可提供的服务
-
详解PostgreSQL 如何获取当前日期时间
-
新版腾讯QQ更新Windows 9.9.7、Mac 6.9.25、Linux 3.2.5版本
-
一文看懂mysql时间函数now()、current_timestamp() 和sysdate()
-
流星蝴蝶剑:76邵氏精华版,强化了流星,消失了蝴蝶
-
PhotoShop通道
-
查看 CAD文件,电脑上又没装AutoCAD?这款CAD快速看图工具能帮你
-
WildBit Viewer 6.13 快速的图像查看器,具有幻灯片播放和编辑功能
-
光与灯具的专业术语 你知多少?
-
- 最近发表
- 标签列表
-
- serv-u 破解版 (19)
- huaweiupdateextractor (27)
- thinkphp6下载 (25)
- mysql 时间索引 (31)
- mydisktest_v298 (34)
- sql 日期比较 (26)
- document.appendchild (35)
- 头像打包下载 (61)
- oppoa5专用解锁工具包 (23)
- acmecadconverter_8.52绿色版 (39)
- oracle timestamp比较大小 (28)
- f12019破解 (20)
- np++ (18)
- 魔兽模型 (18)
- java面试宝典2019pdf (17)
- unity shader入门精要pdf (22)
- word文档批量处理大师破解版 (36)
- pk10牛牛 (22)
- server2016安装密钥 (33)
- mysql 昨天的日期 (37)
- 加密与解密第四版pdf (30)
- pcm文件下载 (23)
- jemeter官网 (31)
- iteye (18)
- parsevideo (33)