制作EXCEL抽奖的代码

制作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