Excel抽奖系统VBA宏代码写的!

0
回复
675
查看
[ 复制链接 ]

18

主题

6

回帖

160

积分

管理员

积分
160
最近某个朋友让我写的一个小功能,要求如下:能够抽奖/题,抽取不重复,需要能够自定义题目数量,抽取次数。

针对朋友这个要求,简单的写了一下。
功能如下:
点击“抽取”按钮,在题库范围内抽取。
点击“清除数据”按钮,清除历史抽取数据,一切归零。
在“C21  C22”单元格可以输入总数量和抽取次数。
总数量不能大于右侧试题库内试题的总数量,否则会出BUG!
试题库内容自行在:R列自行输入
在使用过程中,可以隐藏右侧不需要显示的列。
下载:https://duikou.lanzoul.com/iswYQ1qkhing
游客,如果您要查看本帖隐藏内容请回复

VBA代码如下:
  1. Private Sub CommandButton1_Click()
  2. Line1:
  3.     EndNumber = Range("C21").Value
  4.     WorkSum = Range("C1").Value
  5.     If WorkSum >= Range("C22").Value Then
  6.          result = MsgBox("亲,抽奖次数已用完!")
  7.          GoTo Line2
  8.     End If
  9.    
  10.     Randomize
  11.     ' 初始化随机数种子
  12.     RandomNumber = Int((EndNumber - 1 + 1) * Rnd + 1)
  13.     '1到20之间的随机整数
  14.     For i = 1 To EndNumber
  15.         If Range("V" & i) = RandomNumber Then GoTo Line1
  16.     Next
  17.    
  18.         WorkNumber = "R" & RandomNumber
  19.         RandomWorkText = Range(WorkNumber).Value
  20.         '获取题库列值
  21.         Range("B4") = RandomWorkText
  22.         '把值填入题目展示区域
  23.         WorkSum = Range("C1").Value + 1
  24.         Range("C1") = WorkSum
  25.         '抽取次数+1
  26.         Range("T" & WorkSum) = RandomWorkText
  27.         Range("V" & WorkSum) = RandomNumber
  28.     '------------------------------------------
  29. Line2:
  30.    
  31. End Sub

  32. Private Sub CommandButton2_Click()
  33.     EndNumberTwo = Range("C21").Value
  34.     Range("C1") = 0
  35.     Range("B4") = "请点击抽取按钮"
  36.     Range("T1:T" & EndNumberTwo) = ""

  37.     Range("V1:V" & EndNumberTwo) = ""
  38.    
  39. End Sub
复制代码





内容输入区

内容输入区

抽奖区

抽奖区
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则