用EXCEL制作“人鬼过河”游戏-Excel教程

从网上看到有一个小游戏，内容如下：
有3个人和3个鬼一同在A岸，要把这6个都运送到对岸B去，中间隔了条河，只有一艘船，船上最多只能载2个人（或者鬼）随意组合。但是在同一岸的人数只要少于鬼的数量，那么人就会被鬼吃了（即：若任何一岸有2鬼1人，3鬼1人，3鬼2人都不行） 请问要怎么样把这6个都运送到对岸B去呢? 从B岸返回A岸时必须有一个人或一鬼划船。
下面我们就用EXCEL做一个游戏，可以让大家亲自体验一下“过河”的过程。

前期准备工作（包括相关工具或所使用的原料等）

excel

详细的具体步骤或操作方法

1先做一个界面，如下图：
2打开一个空白工作表，将其底部标签名字改成“手动”。
其中A2:A7表示A岸，D2：D7表示B岸，B2:C7充填兰色，表示河。
3按上图用“窗体”工具栏添加两个按钮，分别起名为“初始化”与“过河”。

在菜单上按“视图－工具栏－窗体”调出“窗体”工具栏，如下图：

4
提示：这是在EXCEL2003中的“窗体”工具，如果你用的是2007版的，需要在“开发工具－插入－表单控件”，如下图：
5

6在“手动”工作表的底部标签名字上按鼠标右键，从快捷菜单中选“查看代码”，调出该工作表项目的VBA窗口，并把下面代码粘贴进去。7Dim n '计数
Dim g '标志
Dim x1, x2, y1, y2, fx, q
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
x=Target.Row
y=Target.Column
If (y=1 Or y=4) And (x > 1 And x < 8) And Target.Count=1 Then
ActiveSheet.Unprotect
If n=2 Then '超员或非同岸则复位
g=0: n=0: Call 清除颜色
If
If y1 <> 0 And y <> y1 Then Call 清除颜色: n=0: y1=0: Exit Sub
If n=1 And y=y1 Then Target.Interior.ColorIndex=6: x2=x: y2=y: n=n + 1: g=1
If n=0 Then Target.Interior.ColorIndex=6: x1=x: y1=y: n=n + 1: g=1
ActiveSheet.Protect
If
Sub
Private Sub 初始()
n=0: x1=0: x2=0: y1=0: y2=0: g=0
Call 清除颜色
Sub
Private Sub 清除颜色()
Range("a2:a7").Interior.ColorIndex=xlNone
Range("d2:d7").Interior.ColorIndex=xlNone
Sub
Sub 过河()
If n=0 Then MsgBox "请选择成员": Exit Sub
ActiveSheet.Unprotect '撤消保护
q=q + 1: Range("b9")="第 " & q & " 步"
If n=1 Then
If Cells(x1, y1)="" Then MsgBox "请选择成员": Exit Sub
If y1=1 Then Call yd(x1, 8, 1): Call 清除颜色
If y1=4 Then Call yd(x1, 8, -1): Call 清除颜色
If
If n=2 Then
If x1=0 Or x2=0 Or Cells(x1, y1)="" Or Cells(x2, y2)="" Then MsgBox "请选择成员": Exit Sub
If y2=1 Then Call yd(x1, x2, 1): Call 清除颜色
If y2=4 Then Call yd(x1, x2, -1): Call 清除颜色
If
Call 初始
If fx=1 Then
fx=-1: ScrollArea="$D1:$D7": t="请从 B 岸选择成员"
Else
fx=1: ScrollArea="$A1:$A7": t="请从 A 岸选择成员"
If
Range("a10")=t
'判断是否失败
mr1=WorksheetFunction.CountIf(Range("a2:a7"), "人")
mg1=WorksheetFunction.CountIf(Range("a2:a7"), "鬼")
mr4=WorksheetFunction.CountIf(Range("d2:d7"), "人")
mg4=WorksheetFunction.CountIf(Range("d2:d7"), "鬼")
If (mr1 <> 0 And mr1 < mg1) Or (mr4 <> 0 And mr4 < mg4) Then MsgBox "失败了，重新开始", , "提示": Call 重新开始
If mr4=3 And mg4=3 Then MsgBox "恭喜你胜利了", , "提示": Call 重新开始
ActiveSheet.Protect '保护
Sub
Private Sub yd(x1, x2, fx)
If fx=1 Then
y=1
For i=1 To 3
Cells(x1, y + 1)=Cells(x1, y): Cells(x1, y)=""
Cells(x2, y + 1)=Cells(x2, y): Cells(x2, y)=""
y=y + 1: Call 延时
Next
Else
y=4
For i=1 To 3
Cells(x1, y - 1)=Cells(x1, y): Cells(x1, y)=""
Cells(x2, y - 1)=Cells(x2, y): Cells(x2, y)=""
y=y - 1: Call 延时
Next
If
Sub
Private Sub 延时()
For i=1 To 50000000: Next
Sub
Sub 重新开始()
ActiveSheet.Unprotect '撤消保护
Sheets("手动").Select
q=0: Range("b9")="" '清空步数
Range("a1")="A岸": Range("b1")="河": Range("d1")="B岸"
Range("a2:a4")="人": Range("a5:a7")="鬼": Range("b2:d7")=""
fx=1 '方向
ScrollArea="$A1:$A7"
Range("a10")="重新开始，请从 A 岸选择成员"
Call 初始
ActiveSheet.Protect '保护
Sub
8给按钮指定宏

用鼠标右键选中上面添加的“初始化”按钮，从弹出的快捷菜单中选“指定宏”，在弹出的宏窗口中选择“重新开始”宏，确定。

用鼠标右键选中上面添加的“过河”按钮，从弹出的快捷菜单中选“指定宏”，在弹出的宏窗口中选择“过河”宏，确定。

9完成

这样就完成了，可以开始游戏了。

回到EXCEL窗口，先用鼠标点击“初始化”按钮，再用鼠标选择一至两个过河成员后，按“过河”按钮就可以游戏了。
在游戏过程中如果失败或胜利会有提示。

注意事项

由于要对游戏当中的一些事件进行处理，所以VBA代码部分有些长，看不明白也不要紧，只要把它粘贴到对应的位置就行了。经验内容仅供参考，如果您需解决具体问题(尤其法律、医学等领域)，建议您详细咨询相关领域专业人士。作者声明：本文系本人依照真实经历原创，未经许可，谢绝转载。