如何用数据表格抽奖

A. excel用权重实现概率抽奖，要用VBA实现的，大量模拟数据，一次抽不重复的4个

随机一次抽不重复的4个，可以？
1、假设参与抽奖的姓名或编号在A列（A1、A2、A3...........）。
2、在B列 输入 =rand() 然后向下复制。
3、在 C列 （得奖栏）任意单元格输入：=INDEX(A:A,MATCH(SMALL(B:B,ROW(A1)),B:B,0))下拉（抽取名额数，即有几名得奖就下拉/复制几介单元格），每按一次F9 就得到一组随机抽得的名单

B. 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

C. 怎样用excel制作随机抽取不重复

在excel里，要想实现抽样调查或者随机抽取，可以利用随机函数rand来实现。

示例图片：

如上图所示，数据列是张三1至张三30，现在想随机抽取10人，可以在空白列建立辅助列，并输入公式：=RAND()，生成随机数，然后复制该列，粘贴为数值，按照升序或者降序排列，并抽取前十名即可。

注意，rand是随机函数，按下F9可以刷新，所以将函数生成的数据粘贴为数值，使其不再变化。

D. 用excel函数实现一个抽奖的功能

操作上是可以的，就是你已经抽取的数据必须要输入到指定的列或者区域，否则想用函数公式是没有办法实现的。

E. 抽签表制作完成后可以使用哪个快捷键进行抽取数据

抽签表制作完成后可以使用F9快捷键进行抽取数据。F9是execl表格中的刷新快捷键，按F9可进行随机抽选人名等数据。例如随机抽取A-I的员工：首先，在第二列输入函数：=RAND()来生成随机数。第二步，在第三列输入函数：=RANK(B1,B:B)来对随机数排序以生成整数。第三步，就可以用INDEX函数制作抽奖小程序。在F2输入函数：=INDEX($A$1:$A$9,C1)。最后可以按【F9】一键刷新抽取。

F. 如何做一个excel抽签，而且抽过的内容不再被第二次抽出

Excel中，由952组数据中随机抽取360组不重复的数据。
开启分步阅读模式
工具材料：
安装Excel程序的电脑
操作方法
01
如果数据在Sheet2 的A:D列，在Sheet2的A列前插入两列辅助列；
02
在左上角的名称框中，输入A2:A953，按Enter键，将A2:A953单元格选中，输入=RAND()，按Ctrl+Enter组合键结束，快速向A2:A953单元格中输入随机数（随机数的重复机率极低）；

03
在B2单元格输入以下公式，然后向下填充公式，得到A列数据的排名（同样没有重复排名）
=RANK(A2,A:A)

04
在Sheet1的A2单元格输入以下公式，然后向右向下填充公式到D361单元格，得到由Sheet2工作表中随机取得的不重复的360行数据
=VLOOKUP(ROW()-1,Sheet2!$B:$F,COLUMN(B1),0)
公式表示：以当前行号在Sheet2的B列精确匹配对应行，并返回对应第2列（Sheet2的C列）数据。

05
因随机取数时，工作表只要输入一个数据，就会在“自动计算”中 重新得到一组数据，因此，可以将Sheet2的A列，“复制”并“选择性粘贴”为“数值”，避免数据不断变换。或者将“公式”选项中的“计算选项”设置为“手动”。
特别提示
通过RANDBETWEEN函数得到随机函数的方法，会出现重复数据，从而达不到既随机又唯一取数的目的，没有RAND得到一列不重复的随机数再排名来得科学有效。

G. excel表格抽奖如何做

01打开excel，并点击excel的最左上角的图标，找到“Excel 选项”。



02
找到“常用”点击，然后在右侧找到“在功能区显示‘开发工具’选项卡”复选框打钩，按确定。



03
点击开发工具，调出开发控件



04
利用调出的开发控件，2个Label，2个TextBox，1个按钮。结合Excel知识，制作如下界面。







05
可以在视图中找到宏，也可以在开发工具中找到宏。然后打开宏编辑。



06
添加VBA代码：
Option Base 1
Dim t1 As Long '范围1
Dim t2 As Long '范围2
Dim czh As Integer '抽奖号码
Dim num As Integer
Sub auto_open()
Application.OnKey "{ENTER}", "cj"
Application.OnKey "~", "cj"
End Sub
Public Function tj(lb) As Integer
Dim k As Integer
k = 2
Do
Set myR = Sheets(lb).Cells(k, 1)
If Trim(myR.Value) = "" Then '出现空记录
Exit Do
End If
k = k + 1
Loop Until False
tj = k - 1
End Function
Public Function csf()
num = tj("temp")
With Worksheets("temp")
t1 = .Cells(num, 3).Value
t2 = .Cells(num, 4).Value
End With
Worksheets("抽奖程序").TextBox1.Text = t1
Worksheets("抽奖程序").TextBox2.Text = t2
End Function
Public Function cj()
num = tj("temp")
Call csf
Call cjsz
End Function
Public Function cjsz()
Dim r(10)
For i = 1 To 10
xh = False
Do
d = Int((t2 - t1 + 1) * Rnd + t1)
j = 0
Do
j = j + 1
If r(j) = d Then
xh = False
Exit Do
Else
xh = True
End If
Loop Until j >= i
Loop Until xh = True
r(i) = d
Next i
Dim b(1 To 10)
For i = 1 To 10
b(i) = Application.WorksheetFunction.Small(r, i)
Worksheets("抽奖程序").Label1.Caption = ""
Next
For j = 1 To 10
For i = 1 To 2000
If i Mod 100 = 0 Then
DoEvents
End If
m = Int((t2 - t1 + 1) * Rnd + t1)
Worksheets("抽奖程序").Label2.Caption = Format(m, "00000")
Next i
d = b(j)
Worksheets("抽奖程序").Label2.Caption = Format(d, "00000")
Worksheets("抽奖程序").Label1.Caption = Worksheets("抽奖程序").Label1.Caption & " " & Worksheets("抽奖程序").Label2.Caption
Next j
nn = tj("数据统计")
With Worksheets("数据统计")
.Cells(nn + 1, 1).Value = nn
.Cells(nn + 1, 2).Value = Date
.Cells(nn + 1, 3).Value = Worksheets("抽奖程序").Label1.Caption
End With
For i = 1 To 14
j = nn + 2 - i
If j > 1 Then
With Worksheets("数据统计")
a = .Cells(nn + 2 - i, 2).Value
c = .Cells(nn + 2 - i, 3).Value
End With
With Worksheets("抽奖程序")
.Cells(i + 1, 14).Value = a
.Cells(i + 1, 15).Value = c
End With
Else
Exit For
End If
Next i
End Function



07
点击按钮测试，得到随机中奖编号

H. 如何在excel表格中制作抽奖卷模板

LARGE函数，返回数据集中的第K个最大值。IF函数。MMULT函数，矩阵乘积函数。

ROW函数，返回指定单元格函数。INDIRECT函数，对引用进行计算，显示其内容。

TRANSPOSE函数，转置公式 , 就是把 竖列 变成横行的函数。这个函数是为了方便看。

RANDBETWEEN函数，返回大于等于指定的最小值，小于等于指定最大值之间的一个随机整数的函数。

方法/步骤

1.抽奖就以大乐透的形式来讲，在1到37之间选7个数，这7个数就是获奖的数字。

I. excel随机抽奖有规律吗

excel随机抽奖有规律。

假设参与抽奖的号码或姓名在A列，就在B列输入 =rand() 然后向下复，在 C列 （得奖栏）输入：=INDEX(A:A,MATCH(SMALL。

菜单栏——文件——新建——右侧出现《新建工作簿》窗格——本机上的模板——出现《模板》对话框——电子方案表格——选“抽奖器”——确定——编辑界面出现与《Microsoft Excel – Book1》。

让数据显示不同颜色：

在学生成绩分析表中，如果想让总分大于等于500分的分数以蓝色显示，小于500分的分数以红色显示。操作的步骤如下：首先，选中总分所在列，执行“格式→条件格式”，在弹出的“条件格式”对话框中，将第一个框中设为“单元格数值”、第二个框中设为“大于或等于”。

然后在第三个框中输入500，单击[格式]按钮，在“单元格格式”对话框中，将“字体”的颜色设置为蓝色，然后再单击[添加]按钮，并以同样方法设置小于500，字体设置为红色，最后单击[确定]按钮。 这时候，只要你的总分大于或等于500分，就会以蓝色数字显示，否则以红色显示。