大家好，欢迎来到IT知识分享网。

【分享成果，随喜正能量】人生的重启方式，在于信心的强大，勇敢一些，快乐一些，增加信心，升华情怀。那些暂时化解不了的生命困顿，便用情怀的超越去转化它。。

《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 = i + 1

Loop

‘序号排序，人员序号从开始的顺序打乱一下

.Range(“A3:B” & lCount + 3).Sort Key1:=.Range(“A3”), _

Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

‘再次按照随机数排序

.Range(“A3:B” & lCount + 3).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 = (lCT + i – 1) Mod (lCount)

If TT = 0 Then TT = lCount

.Range(“J” & i + 2) = Sheets(“Sheet1”).Cells(TT + 3, 1)

If Range(“J” & i + 2).Interior.Color = RGB(255, 0, 0) Then

Range(“J” & i + 2).Interior.Color = RGB(60, 160, 230)

Range(“I” & i + 2).Interior.Color = RGB(213, 213, 213)

Range(“K” & i + 2).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” & i + 2).Interior.Color = RGB(255, 0, 0)

Range(“I” & i + 2).Interior.Color = RGB(153, 153, 153)

Range(“K” & i + 2).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 Now + TimeValue(“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 = lValue

Else

AddNumbers = False

End If

End Function

代码截图：

代码讲解：

1） Do While .Cells(i, 1) <> “”

.Cells(i, 2) = WorksheetFunction.RandBetween(1, lCount * 10)

i = i + 1

Loop

以上代码会产生随机数，用于乱序排序。

2）.Range(“A3:B” & lCount + 3).Sort Key1:=.Range(“A3”), _

Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

‘再次按照随机数排序

.Range(“A3:B” & lCount + 3).Sort Key1:=.Range(“B3”), _

Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

以上代码是两次排序，第一次是打乱初始录入的人员序号，第二次是乱序排序，经过这两次排序，希望对每个参与游戏者都是公平的。

3）For i = 1 To 26

TT = (lCT + i – 1) Mod (lCount)

If TT = 0 Then TT = lCount

.Range(“J” & i + 2) = Sheets(“Sheet1”).Cells(TT + 3, 1)

If Range(“J” & i + 2).Interior.Color = RGB(255, 0, 0) Then

Range(“J” & i + 2).Interior.Color = RGB(60, 160, 230)

Range(“I” & i + 2).Interior.Color = RGB(213, 213, 213)

Range(“K” & i + 2).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” & i + 2).Interior.Color = RGB(255, 0, 0)

Range(“I” & i + 2).Interior.Color = RGB(153, 153, 153)

Range(“K” & i + 2).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

Range(“M1”).Interior.ColorIndex = 27

这段代码是取消“幸运大转盘”五个字的动画效果。

【待续】

我20多年的VBA实践经验，全部浓缩在下面的各个教程中：

【分享成果，随喜正能量】 我们平常说祝福未来的精彩，其实是活好今天的信心、细水长流的日子、踏实冷静的面对和努力去呈现的一个个体的价值、个体的精神、个体的风采在群体当中的一种融合、担当和责任。。