如何用Excel制作一个抽奖程序

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 选项”找到开发工具

本文内容整理自网络, 文中所有观点看法不代表淘大白的立场