excel抽奖小程序(excel抽奖小程序不重复)

1. excel抽奖小程序不重复

用vba编个程序可以实现。

将一个案例分享给大家。程序页面如下：

部分代码如下：

Private Sub CommandButton4_Click()

'开始抽奖

Dim zb As String, dj As String, rs As Integer

Dim SARR(1 To 5000, 1 To 2) '存放本次抽奖的候选人清单 1-姓名 2-电话号码

'Dim lsARR '存放最近100次的候选人

Dim ZZ1 As Integer, ZZ2 As Integer, ZZ3 As Integer

'Dim jgarr

Dim ysARR(1 To 3, 1 To 3) As Integer '三种颜色参数

Dim zjZD '仅存放姓名+半角分号（;)+4位尾号

Dim myName As String

Dim hxRs As Integer, ZJRS As Integer '候选人数,中奖人数

Const lsRs = 100 '存放100位候选人

Set zjZD = CreateObject("scripting.dictionary")

'ReDim jgarr(1 To ZJRS) As Long

A = 0 '

ysARR(1, 1) = 255: ysARR(1, 2) = 250: ysARR(1, 3) = 0

ysARR(2, 1) = 255: ysARR(2, 2) = 10: ysARR(3, 3) = 10

ysARR(3, 1) = 255: ysARR(3, 2) = 250: ysARR(3, 3) = 0

'清空颜色

For I = 1 To 15

myName = "TextBox" & I

Set xx = Me.Controls(myName)

xx.BackColor = RGB(255, 255, 255)

xx.ForeColor = RGB(255, 215, 0)

xx.Font.Size = 10

xx.BackStyle = 0

ZZ3 = ZZ3 - 1

If ZZ3 = 0 Then ZZ3 = 15

Next I

zb = ComboBox1.Value

dj = ComboBox2.Value

ZJRS = ComboBox3.Value '中奖人数

'读取还可抽取人数

With Sheets("中奖人数设定")

For I = 3 To 8

If .Cells(I, 2) = zb Then Exit For

Next I

For j = 9 To 11

If .Cells(2, j) = dj Then Exit For

Next j

kcqrs = .Cells(I, j) '可抽取人数

End With

If ZJRS = 0 Or ZJRS > kcqrs Or ZJRS > 15 Then

MsgBox ("抽奖人数设置不正确！")

Exit Sub

End If

ReDim jgarr(1 To ZJRS, 1 To 2)

'读取候选人 放入sarr

Select Case zb

Case "A"

lh = 2

Case "B"

lh = 5

Case "C"

lh = 8

Case "D"

lh = 11

Case "E"

lh = 14

Case "F"

lh = 17

End Select

hxRs = 0

With Sheets("人员清单")

HH = 3

Do While .Cells(HH, lh) <> ""

If .Cells(HH, lh + 2) = "" Then '检查是否中奖，已经中奖的不得参与摇奖

hxRs = hxRs + 1

SARR(hxRs, 1) = .Cells(HH, lh)

SARR(hxRs, 2) = .Cells(HH, lh + 1)

End If

HH = HH + 1

Loop

End With

ZZ1 = 0: ZZ2 = 0: ZZ3 = 0

upperbound = hxRs

lowerbound = 1

'1-11:中奖人数和候选人数一样时，单独做一个循环

If ZJRS < hxRs Then GoTo 200

'一样时

Do While True

For ZZ2 = 1 To hxRs

myName = "TextBox" & ZZ2

Set xx = Me.Controls(myName)

xx.Text = SARR(ZZ2, 1) & Chr(10) & Right(SARR(ZZ2, 2), 4)

Next ZZ2

DoEvents '释放程序控制权，允许其他事件

Sleep (5) '延时ms

DoEvents '释放程序控制权，允许其他事件

If A = 1 Then GoTo 300

Loop

200:

Do While True

100:

SJS = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

MYKEY = Trim(SARR(SJS, 1)) & ";" & Trim(Right(SARR(SJS, 2), 4))

If zjZD.EXISTS(MYKEY) Then

ZZ1 = ZZ1 + 1

If ZZ1 > 10000 Then

MsgBox ("数据异常！！！")

Exit Sub

End If

GoTo 100

End If

'ZZ1 = ZZ1 + 1

'If ZZ1 = 101 Then ZZ1 = 1

ZZ2 = ZZ2 + 1

If ZZ2 = ZJRS + 1 Then ZZ2 = 1

'ZZ3 = ZZ3 + 1

'If ZZ3 = 4 Then ZZ3 = 1

'lsARR(ZZ1) = sjs

myName = "TextBox" & ZZ2

Set xx = Me.Controls(myName)

'xx.Text = Left(SARR(SJS, 2), 3) & "XXXX" & Right(SARR(SJS, 2), 4)

xx.Text = SARR(SJS, 1) & Chr(10) & Right(SARR(SJS, 2), 4)

zjZD.RemoveAll

For I = 1 To ZJRS

myName = "TextBox" & I

Set xx = Me.Controls(myName)

If xx.Text <> "" Then

MYKEY2 = qczf(Left(xx.Text, InStr(xx.Text, Chr(10)) - 1)) & ";" & Right(xx.Text, 4)

zjZD.Add MYKEY2, I

End If

Next I

'xx.BackColor = RGB(ysARR(ZZ3, 1), ysARR(ZZ3, 2), ysARR(ZZ3, 3))

DoEvents '释放程序控制权，允许其他事件

Sleep (5) '延时ms

DoEvents '释放程序控制权，允许其他事件

300:

If A = 1 Then

For I = 1 To ZJRS

myName = "TextBox" & I

Set xx = Me.Controls(myName)

xx.BackColor = RGB(ysARR(1, 1), ysARR(1, 2), ysARR(1, 3))

xx.ForeColor = RGB(0, 0, 255)

xx.Font.Size = 20

xx.BackStyle = 1

'ZZ3 = ZZ3 - 1

'If ZZ3 = 0 Then ZZ3 = 15

Next I

Exit Sub

End If

Loop

End Sub

Private Sub CommandButton5_Click()

A = 1

End Sub

Private Sub CommandButton6_Click() '记录中奖信息

Dim zjZD

Dim ZJRS

Dim zjArr

zb = ComboBox1.Value '组别

dj = ComboBox2.Value '等级

ZJRS = ComboBox3.Value '中奖人数

Set zjZD = CreateObject("scripting.dictionary")

'遍历文本框，获取中奖的电话号码

For I = 1 To ZJRS

myName = "TextBox" & I

Set xx = Me.Controls(myName)

ARR = Split(xx.Text, Chr(10))

MYTEXT = qczf(ARR(0)) & ";" & qczf(ARR(1))

zjZD.Add MYTEXT, I

xx.Text = ""

xx.BackColor = RGB(255, 255, 255)

Next I

Select Case zb

Case "A"

lh = 2

Case "B"

lh = 5

Case "C"

lh = 8

Case "D"

lh = 11

Case "E"

lh = 14

Case "F"

lh = 17

End Select

With Sheets("人员清单")

For I = 3 To .Cells(10000, lh).End(xlUp).Row

'SARR(SJS, 1) & Chr(10) & Right(SARR(SJS, 2), 4)

'mytext = Left(.Cells(I, lh + 1).Text, 3) & Right(.Cells(I, lh + 1).Text, 4)

MYTEXT = qczf(.Cells(I, lh).Text) & ";" & qczf(.Cells(I, lh + 1).Text)

If zjZD.EXISTS(MYTEXT) Then

.Cells(I, lh + 2) = dj

End If

Next I

End With

End Sub

Private Sub Frame2_Click()

xxx = 1

End Sub

Private Sub UserForm_Initialize()

Dim xstr(1 To 6) As String '保存每列的数据

Dim ystr(1 To 3) As String

Dim zstr(1 To 15) As Integer '

xstr(1) = "A"

xstr(2) = "B"

xstr(3) = "C"

xstr(4) = "D"

xstr(5) = "E"

xstr(6) = "F"

ComboBox1.List = xstr

ystr(1) = "一等奖"

ystr(2) = "二等奖"

ystr(3) = "三等奖"

ComboBox2.List = ystr

For I = 1 To 15

zstr(I) = I

Next I

ComboBox3.List = zstr

ComboBox3.Value = 15

End Sub

2. vba抽奖不重复

用以下方法，Excel 制作抽奖和抽班委原理一样的

我用的版本是 Excel 2016，其他版本的界面可能略有不同。

案例 1：如何从 10 个人中一次性抽取 3 名获奖者，且所有中奖者不重复？

案例 2：如何从 10 个人中依次抽取 1、2、3 等奖各 1 名，每次抽取后固定住获奖者，且所有中奖者不重复？

所需函数及功能：

RAND()

RANK(number, ref, [order])

INDEX(array, row_num,[column_num])

IF(logical_test,[value_if_true],[value_if_false])

Conditional Formatting

为了便于理解，我把每个步骤拆开来讲解。

案例 1 解决方案：

以下是 10 个人员的名单，现在需要从中一次性抽 3 个幸运儿。

1. 在 B 列用 Rand 函数生成 10 个随机数

2. 在 C 列用 Rank 函数对这 10 个随机数排序

公式：=RANK(B2,B$2:B$11)

翻译：计算 B2 单元格在 B2~B11 数组中的排名，默认从大到小排。

3. 在 D 列用 Index 函数按 C 列的随机排名抽出中奖者。因为需要一次抽 3 个人，所以我们拉 3 行公式即可。

公式：=INDEX(A$2:A$11,C2)

翻译：在A列的指定数组中，读取出第 n 行单元格

使用方法 ：

按住 F9，数字开始滚动，抽奖开始

放开按键，即为抽奖结果（因为 rand 函数基本不可能出现重复值，所以中奖人不会重复）

* 请注意：由于随机函数每次都会随机变化，为了固定住获奖人员名单，请复制获胜者名单，并且 paste value 到其他单元格。

案例 2 解决方案：

增加的需求:

每次抽一个人，抽出后固定中奖者

不得重复中奖

1. 给 D 的公式加个 if 条件，同时增加辅助列 E

公式：=IF(E2=1,D2,INDEX(A$2:A$11,C2))

翻译：如果 E2 单元格为 1，则固定 D2 单元格的值，否则，继续抽奖

当我们在 E2 中输入“1”以后，无论何时按下或放开 F9 抽奖，D2 的“王7”始终是固定的。

现在我们要抽第 2 个人，但是“王7”不可以重复中奖，怎么做？

在不使用 vba 的情况下，此处推荐一种最简便的方法。

2. 选中 D2~D11 --> 按 Ctrl + Q --> 选择 Formatting --> Duplicate Values

翻译：当“中奖者”区域内有重复人员，则高亮显示

如下，当我们抽第 2 个人的时候，又抽到了“王7”，会自动高亮显示。

3. 现在抽奖器已经做好了，我们把模板调整美观，再写个操作说明。

1) 把人员名单及辅助列移到“人员名单”sheet 中

2) 选中 E 列，通过 Format Cells --> Custom，把“1”显示为“已中奖”

这就是最终的抽奖模板和使用说明，有时间的话，可以加点图片效果什么的，然后就可以在公司年会耍酷啦！

使用说明：

1、将参加抽奖的人员名单，维护在“人员名单”表里面

2、按住 F9 开始抽奖（此时可以看到B列内容一直在变化）

3、一会功夫，放手，B 列此时就是被选出来的“中奖人”

4、在 C 列的第一个黄色单元格输入“1”，以便把“中奖人”锁定

5、重复 2~4 步骤抽二等奖（如果B列出现红色背景，则重复 2~3 步骤）

6、以此类推，抽出三等奖

3. ppt抽奖小程序不重复

1、浏览电脑上的所有软件的一些基本信息，针对如何在ppt中加入随机抽签的问题，只需要找到要用到的ppt软件这个选项，然后点击进入。

2、随后找到页面中的插入工具并点击，随后会出现一个窗口，找到窗口中的文本框，然后点击。

3、随后在主页面创建好五个文档，然后在文档中填写好需要用到的数字1-5的序号。

4、随后浏览页面中的工具选项，找到需要用到的幻灯片放映这个选项，然后点击，接着会出现一个窗口，找到窗口中的自定义幻灯片放映这个选项，然后点击。

5、随后会出现一个放映的选择窗口，浏览窗口中的所有选项信息，找到需要用到的循环放映这个选项，然后点击勾选中并点击确定。

6、最后点击从头放映这个选项，这样ppt的随机抽签就成功的制作好了。

4. excel随机函数抽奖不重复

　　如果用EXCEL做，可先选中几个单元格，加上边框，并填入自己想要的文字，编号位置单独占用一个单元格。

　　还可把做好的一张多复制几个，编号用公式，使其自动增加，就能一次在一张A4纸上打印多个不同编号的抽奖券了。

5. Excel抽奖小程序

将编号、名字编一个excel表。條萊垍頭

用word做一个格式模版，通过邮件合并功能导入excel数据，自动生成批量抽奖券，即可打印。垍頭條萊

6. vb抽奖小程序不重复中奖

1、点击电脑桌面右键选择新建，在列表里面选择表格，然后输入要使用的抽奖数据。

2、然后点击中间部分的单元格，选中要使用的单元格进行合并，输入中奖号码标识。

3、双击点击中奖号码的单元格，输入＂=INDIRECT("A"&RANDBETWEEN(2，21))"，选中抽奖号码区域。

4、选中左侧编辑好的数据，选择上方的样式选项－突出单元格格式，继续选择“等于”，根据提示选择即可。

5、选中单元格里面的字体，找到上方的“开始”菜单，对单元格字体的大小和颜色进行设置。

6、点击设置右侧单元格的填充颜色，选择中奖单元格为黄色填充，更容易区分单元格。

7、设置好单元格格式以后，点击按住键盘上的F9开始抽奖，松开按键就可以看到获奖数字。

7. excel抽奖小程序内定抽奖者

步骤如下，希望能够对你有所帮助。

1、首先用Excel打开需做的文件，在单元格输入奖品，在旁边选几个单元格合并（这样好看点，也可以就一个单元格），接下来在单元格输入=号。

2、然后再输入RAN，接着会弹出选项框，移动鼠标选择第二个RANDBETW点击鼠标左键，然后再输入奖品从第几列开始输入数字几（如下图从14列开始），然后输入逗号，再输入结束列（如下图所示23列）

3、接下来我们点击到公式的=号后面，输入IND就会弹出选项框，选择第一个INDEX。

4、选择第一个INDEX，然后逗号，按住鼠标左键拖动选中全部奖品（如下图所示），然后按回车就可以了。

5、接下来就是怎么抽奖了，只要按住F9就可以滚动抽奖页面了，放开就是抽奖项了。

8. excel抽奖小程序不重复抽签

材料/工具：Excel2010

1、打开电脑后，直接进入到excel软件中，新建一个空白的表格文档，在表格中某一列单元格中录入好我们要抽取的内容，例如姓名，编号等等。

2、录入完成后，我们在当前表格文档中重新再去选择一个单元格，将其作为最终抽取结果的展示用。

3、接着我们在该抽奖结果单元格中输入以下公式：“=INDEX(A:A，RANDBETWEEN(2,61))"。

4、在“=INDEX(A:A，RANDBETWEEN(2,61))"公式中，A：A表示我们要抽取的内容所在的单元格列范围为A列A列，可以自定义。

5、公式输入完成后，在抽取结果单元格就会随机产生一个抽取结果，我们可以为该抽取结果单元格设置一个格式：字体、字号、颜色等等。

6、设置好之后，想要开始抽奖或者抽签，我们只需要选中抽取结果单元格，然后按住键盘上的“F9”键，按下后在抽取结果单元格中就会在我们选择的抽取内容中随机产生抽取结果，松开“F9”就可以产生一个抽取结果。

9. Excel抽奖不重复

我们平时总用到excel表格，但是很多人还不知道excel表格是可以制作抽奖小程序的，这个程序对我们来说非常方便，无论是对于小公司，还是大公司来说，这个都是抽奖的最好方法，那么如何实现呢，下面我来教大家如何操作。

工具/原料

excel表格

电脑

方法/步骤

1、我们打开excel表格，在表格中输入本次抽奖的奖品。

2、然后我们选中旁边一个大点的表格，扩选一下，再次点击“合并居中”。

3、接下来在空白大表格中，我们输入“=RANDBETWEEN()”。

4、然后再后边小括号中输入“1,10”，其中1是横向第一行，10是纵向第十行，这个数字你们可以自己设定，根据奖品排数设定的。设置上述内容完毕后，我们需要在“=”后边加上“INDEX(A:A,”。最终我们输入的总数字是“=INDEX(A:A,RANDBETWEEN(1,10)”。

5、输入了完了“INDEX(A:A,”后，我们这时按下回车键，得到下图内容。

6、我们要将左边的奖品隐藏掉，操作方法是，右键点击坐标上面的“A”，点击菜单中的“隐藏”选项。

7、最后我们按住“F9”转盘开始转了起来，松开F9停手，就可以抽到随机奖品， 这就是我们所说的抽奖小程序。