Excel具有強大的功能，這裡介紹如何用Excel內建的VBA製作一個簡單的抽獎程式
工具/原料
Excel2007
VBA
方法/步驟
開啟excel，並點選excel的最左上角的圖示，找到“Excel 選項”
找到“常用”點選，然後在右側找到“在功能區顯示‘開發工具’選項卡”複選框打鉤，按確定。
點選開發工具，調出開發控制元件
利用調出的開發控制元件，2個Label，2個TextBox，1個按鈕。結合Excel知識，製作如下介面。
可以在檢視中找到巨集，也可以在開發工具中找到巨集。然後開啟巨集編輯。
新增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
點選按鈕測試，得到隨機中獎編號。
注意事項
Excel2007版本需要利用“Excel 選項”找到開發工具