【分享成果 ， 随喜正能量】人生的重启方式，在于信心的强大，勇敢一些，快乐一些，增加信心，升华情怀 。那些暂时化解不了的生命困顿，便用情怀的超越去转化它 。。
《VBA高级应用30例》（10178985） ， 是我推出的第十套教程，教程是专门针对高级学员在学习VBA过程中提高路途上的案例展开，这套教程案例与理论结合，紧贴“实战”，并做“战术总结”，以便大家能很好的应用 。教程的目的是要求大家在实际工作中分发VBA程序，写好的程序可以升级 。本套教程共三册三十个专题 ， 今日内容是第5 个专题“利用VBA制作一个转盘游戏”，今日讲解：利用VBA制作一个转盘游戏之三：转盘转动
应用5 利用VBA制作一个转盘游戏
在实际工作中，我们发现Excel是一个非常严肃和强大的应用程序 ， 但这并不意味着我们不能从中得到乐趣 。在本文中，我将给大家讲解如何构建一个Excel文件，使您能够玩幸运轮，同时我们会辅助声音和一些必要游戏基础设施构建！4 转盘游戏代码实现之转盘转动
初始化后，我们要让转盘转动了 ， 看下面的代码：Sub mynzSpinIt()
Dim lCT As Long
Dim lCt2 As Long
Dim lCount As Long
Dim bOK As Boolean
'设置参与的数值数量
lCount = Worksheets("Sheet1").Range("B1").Value
With Worksheets("Sheet1")
Do While bOK = False
i = 4
Do While .Cells(i, 1) <> ""
.Cells(i, 2) = WorksheetFunction.RandBetween(1, lCount * 10)
i = i1
Loop
'序号排序，人员序号从开始的顺序打乱一下
.Range("A3:B" & lCount3).Sort Key1:=.Range("A3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'再次按照随机数排序
.Range("A3:B" & lCount3).Sort Key1:=.Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'音乐效果一共18秒
PlayBackLoop
'建立总数量间的循环
For lCT = lCount To 1 Step -1
'改变开始序号，以期望获得26个对应的数值
With Worksheets("PLAY")
For i = 1 To 26
TT = (lCTi - 1) Mod (lCount)
If TT = 0 Then TT = lCount
.Range("J" & i2) = Sheets("Sheet1").Cells(TT3, 1)
If Range("J" & i2).Interior.Color = RGB(255, 0, 0) Then
Range("J" & i2).Interior.Color = RGB(60, 160, 230)
Range("I" & i2).Interior.Color = RGB(213, 213, 213)
Range("K" & i2).Interior.Color = RGB(213, 213, 213)
Range("G1").Interior.ColorIndex = 13
Range("H1").Interior.ColorIndex = 32
Range("J1").Interior.ColorIndex = 46
Range("L1").Interior.ColorIndex = 38
Range("M1").Interior.ColorIndex = 4
Else
Range("J" & i2).Interior.Color = RGB(255, 0, 0)
Range("I" & i2).Interior.Color = RGB(153, 153, 153)
Range("K" & i2).Interior.Color = RGB(153, 153, 153)
Range("G1").Interior.ColorIndex = 4
Range("H1").Interior.ColorIndex = 13
Range("J1").Interior.ColorIndex = 32
Range("L1").Interior.ColorIndex = 46
Range("M1").Interior.ColorIndex = 38
End If
Next
End With
Next
'停止音效
PlayBackStop
'提取节点
bOK = AddNumbers(Range("Result").Value)
If bOK = False Then MsgBox ("您取得的数值是" & Range("Result").Value & ",此数值重复，转盘将再次运行")
Range("G1").Interior.ColorIndex = 27
Range("H1").Interior.ColorIndex = 27
Range("J1").Interior.ColorIndex = 27
Range("L1").Interior.ColorIndex = 27
Range("M1").Interior.ColorIndex = 27
Loop
End With
Application.Wait NowTimeValue("00:00:01")
Range("Result").Speak
End Sub
Function AddNumbers(lValue As Long) As Boolean
Dim ocell As Range
Dim oSh As Worksheet
Set oSh = Worksheets("Sheet1")
Set ocell = oSh.Range("i2:i1000").Find(lValue, oSh.Range("i2"), xlValues, xlWhole, , xlNext, False, , False)
'在已经提取的列表中没有，那么写入，返回值是True
If ocell Is Nothing Then
AddNumbers = True
oSh.Range("i" & oSh.Rows.Count).End(xlUp).Offset(1).Value = https://www.itzhengshu.com/ppt/lValue
Else
AddNumbers = False
End If
End Function
代码截图：
代码讲解：
1） Do While .Cells(i, 1) <> ""
.Cells(i, 2) = WorksheetFunction.RandBetween(1, lCount * 10)
i = i1
Loop
以上代码会产生随机数，用于乱序排序 。
2）.Range("A3:B" & lCount3).Sort Key1:=.Range("A3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'再次按照随机数排序
.Range("A3:B" & lCount3).Sort Key1:=.Range("B3"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
以上代码是两次排序，第一次是打乱初始录入的人员序号 ， 第二次是乱序排序，经过这两次排序，希望对每个参与游戏者都是公平的 。
3）For i = 1 To 26
TT = (lCTi - 1) Mod (lCount)
If TT = 0 Then TT = lCount
.Range("J" & i2) = Sheets("Sheet1").Cells(TT3, 1)
If Range("J" & i2).Interior.Color = RGB(255, 0, 0) Then
Range("J" & i2).Interior.Color = RGB(60, 160, 230)
Range("I" & i2).Interior.Color = RGB(213, 213, 213)
Range("K" & i2).Interior.Color = RGB(213, 213, 213)
Range("G1").Interior.ColorIndex = 13
Range("H1").Interior.ColorIndex = 32
Range("J1").Interior.ColorIndex = 46
Range("L1").Interior.ColorIndex = 38
Range("M1").Interior.ColorIndex = 4
Else
Range("J" & i2).Interior.Color = RGB(255, 0, 0)
Range("I" & i2).Interior.Color = RGB(153, 153, 153)
Range("K" & i2).Interior.Color = RGB(153, 153, 153)
Range("G1").Interior.ColorIndex = 4
Range("H1").Interior.ColorIndex = 13
Range("J1").Interior.ColorIndex = 32
Range("L1").Interior.ColorIndex = 46
Range("M1").Interior.ColorIndex = 38
End If
Next
以上代码有两个功能，一是完成数值的填充，一是进行颜色的调整 。填充的数值来自固定的RANGE,颜色的填充是按照一定的规律进行 。
4） bOK = AddNumbers(Range("Result").Value)
这句代码是获得结果，同时验证结果 。利用了一个自定义函数AddNumbers，将获得的结果存储，如果结果已经存在于列表中 ， 那么返回的bOK是TRUE，而如果我们转盘定义为幸运观众，同一人不可能出现两次中奖，那么我们要让转盘再次转动 。
5）Range("G1").Interior.ColorIndex = 27
Range("H1").Interior.ColorIndex = 27
Range("J1").Interior.ColorIndex = 27
Range("L1").Interior.ColorIndex = 27
【利用VBA制作一个转盘游戏之三：转盘转动】Range("M1").Interior.ColorIndex = 27
这段代码是取消“幸运大转盘”五个字的动画效果 。
【待续】
我20多年的VBA实践经验 ， 全部浓缩在下面的各个教程中：
【分享成果，随喜正能量】 我们平常说祝福未来的精彩 ， 其实是活好今天的信心、细水长流的日子、踏实冷静的面对和努力去呈现的一个个体的价值、个体的精神、个体的风采在群体当中的一种融合、担当和责任 。。