本文总共1401个字,阅读需5分钟,全文加载时间:2.269s,本站办公入门专栏收录该内容! 字体大小:

文章导读: 最近有用户在后台向我提了一个工作中的小需求,具体如下: ■ 因为公司要组织一个知识竞赛,其中有一个游戏环节,需要从一组名单中随机选出指定数量的人员参加游戏,并且需要在大屏中滚动名单以增强游戏紧张感。……各位看官请向下阅读:

最近有用户在后台向我提了一个工作中的小需求,具体如下:

■ 因为公司要组织一个知识竞赛,其中有一个游戏环节,需要从一组名单中随机选出指定数量的人员参加游戏,并且需要在大屏中滚动名单以增强游戏紧张感。当然最重要的是最终被选中的名单中不能有重复名单出现。她希望能通过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<>""

设置格式

总结:

这个小工具的核心是:利用了字典 数组实现了名单的随机不重复抽取。

如果你也有类似的需求,可以(CTRL+D)收藏本网站,并点击本站上方“视频教程”获取最新课程!

图文教程创作不易,请(CTRL+D)收藏本网站并分享给更多有需求的小伙伴们吧!

送人玫瑰,手有余香!

以上内容由优质教程资源合作伙伴 “鲸鱼办公” 整理编辑,如果对您有帮助欢迎转发分享!

你可能对这些文章感兴趣:

发表评论

您的电子邮箱地址不会被公开。 必填项已用*标注