制作EXCEL抽奖的代码:![主界面图]](https://img-blog.csdnimg.cn/4a9932ffbd3b40eda676ddc7f7fd7067.png#pic_center)
Dim bstop
Dim gdsudu
Dim jiasudu
Sub choujiang()
Dim arr_renyuan
Dim rs, zb
Dim mrgdsudu
bstop = False
With ThisWorkbook.Sheets(“参数表”)
rs = .Range(“C2”).Value
mrgdsudu = .Range(“C3”).Value
jiasudu = .Range(“C4”).Value
arr_renyuan = .Range(“A1:A” & rs)
gdsudu = mrgdsudu
End With
With ActiveSheet
.[H9].Font.Size = 100
Do
.[H9] = arr_renyuan(Application.RandBetween(1, rs), 1)
If gdsudu <= 0 Then gdsudu = mrgdsudu
Delay gdsudu
Loop Until bstop = True
zb = Application.RandBetween(2, 8)
For i = 2 To zb
.[H9] = arr_renyuan(Application.RandBetween(1, rs), 1)
Delay 0.7
Next
With .[H9]
For i = 1 To 2
.Font.Size = 200
Delay 0.3
.Font.Size = 100
Delay 0.3
.Font.Size = 200
Delay 0.3
Next
End With
End With
End Sub
Sub gostop()
bstop = True
End Sub
Sub jiasu()
gdsudu = gdsudu - jiasudu
End Sub
Sub suijijieshu() '自动模式
Dim arr_renyuan
Dim rs
Dim mrgdsudu
Dim sj
bstop = False
With ThisWorkbook.Sheets(“参数表”)
rs = .Range(“C2”).Value '人数
mrgdsudu = .Range(“C3”).Value '默认滚动速度
jiasudu = .Range(“C4”).Value '加速度,另一个过程触发加速
arr_renyuan = .Range(“A1:A” & rs) '人员名单
gdsudu = mrgdsudu
End With
With ActiveSheet
.[H9].Font.Size = 100
sj = Application.RandBetween(rs, rs * 3)
For i = 1 To sj '滚动次数由一个随机范围决定
.[H9] = arr_renyuan(Application.RandBetween(1, rs), 1)
If gdsudu <= 0 Then gdsudu = mrgdsudu '加速是通过减少延时实现,但不能减到0
Delay gdsudu
Next
With .[H9] '出结果了,字体大小闪一闪,嘚瑟一下
For i = 1 To 2
.Font.Size = 200
Delay 0.3
.Font.Size = 100
Delay 0.3
.Font.Size = 200
Delay 0.3
Next
End With
End With
End Sub
Sub Delay(ts) '延时
Dim t, t1
t = Timer
Do
t1 = Timer
If t1 < t Then t1 = 86400 + t1
DoEvents
Loop Until t1 - ts > t
End Sub