返回目录：excel表格制作
表格如图
另外复添加个宏，制功能比较百简单，你也可以加度些暂停什问么的
代码如下：答
Sub 宏1()
Dim iRow As Integer
Dim aRow As Integer
Dim bRow As Integer
iRow = Sheet1.Range("a65536").End(xlUp).Row
Do While iRow > 1
aRow = Int((iRow - 2 + 1) * Rnd() + 2)
bRow = Sheet1.Range("e65536").End(xlUp).Row
Range("e" & CStr(bRow + 1)) = Range("a" & CStr(aRow))
Range("a" & CStr(aRow)).Select
Selection.Delete Shift:=xlUp
iRow = Sheet1.Range("a65536").End(xlUp).Row
Loop
End Sub
那个是人家自己平时收集的模板，个人模板
你的自然是没有的
可以在文件-新建-模板中-从网络上搜索想要的模板！
最简单的抽奖用rand函数就行，但是这个抽奖器观众不会满意的。
那么需要做一个简单的滚动效果，实现方法也不难，一列放数据，一列放=rand()这个公式，把公式这列隐藏掉，然后做个宏，以公式这列排序。VBA写一段代码，每0.1秒调用这个宏一次，那么看起来就是数据这列会定时滚动。
然后再做个按钮，可以中断这个滚动，并打印输出结果。简单的抽奖器模型7a64e78988e69d83339就出来了。
具体代码我贴一个我以前做过的抽签分组的，修改一下就是你要的了：
Private Declare Function timeGetTime Lib "winmm.dll" () As Long '此处声明是调用timeGetTime的时间控制函数
Public a As String
Private Sub 开始_Click()
开始.Enabled = False
停止.Enabled = True
a = 0
Dim Savetime As Double
Do While a = 0
Savetime = timeGetTime '记下开始时的时间
While timeGetTime < Savetime + 100 '循环等待
DoEvents '转让控制权，以便让操作系统处理其它的事件
Wend
If 选项1.Value = True Then
Call bb
Else
Call aa
End If
Loop
End Sub
Private Sub 停止_Click()
停止.Enabled = False
a = 1
Savetime = timeGetTime
While timeGetTime < Savetime + 1000
DoEvents
Wend
开始.Enabled = True
MsgBox "抽签完成，请点击打印"
Sheets(2).Activate
End Sub
Sub aa() '排序部分
Sheets(1).Range("A2:B10").Sort Key1:=Sheets(1).Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets(1).Range("c2:d10").Sort Key1:=Sheets(1).Range("c2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets(1).Range("e2:f10").Sort Key1:=Sheets(1).Range("e2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Sheets(1).Range("g2:h10").Sort Key1:=Sheets(1).Range("g2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub
Sub bb()
Sheets(1).Range("A2:h10").Sort Key1:=Sheets(1).Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub
Excel表格就有抽奖模板。打开空白表格后，在右边有一栏“开始工作抄”的窗口，如果没有，可以打开菜单栏的“工具”-“选项”-“视图”，在“显示”中钩选“启动任务窗格”并保存，重新打开表格就会有的。在这个窗格中点选“新建工作薄”，选“本机上的模板”，在“电子方案百表格”标签里就有多种模板选择了。补充：如果你的OFFICE的确没带上这些度模板，只要到任一台有OFFICE的机子上相同地方找就是了，这个挺好用的。