如何用數據表格抽獎

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分，就會以藍色數字顯示，否則以紅色顯示。