1、先做一个界面，如下图：
2、打开一个空白工作表，将其底部标签名字改成“手动”。其中A2:A7表示A岸，D2：D7表示B岸，B2:C7充填兰色，表示河。
3、按上图用“窗体”工具栏添加两个按钮，分别起名为“初始化”与“过河”。在菜单上按“视图－工具栏－窗体”调出“窗体”工具栏，如下图：
4、提示：这是在EXCEL2003中的“窗体”工具，如果你用的是2007版的，需要在“开发工具－插入－表单控件”，如下图：
6、在“手动”工作表的底部标签名字上按鼠标右键，从快捷菜单中选“查看代码”，调出该工作表项目的VBA窗口，并把下面代码粘贴进去。
7、Dim n '计数Dim g '标志Dim x1, x2, y1, y2, fx, qPrivate Sub Worksheet_SelectionChange(蚱澄堆别ByVal Target As Range)x = Target.Rowy = Target.ColumnIf (y = 1 Or y = 4) And (x > 1 And x < 8) And Target.Count = 1 ThenActiveSheet.UnprotectIf n = 2 Then '超员或非同岸则复位g = 0: n = 0: Call 清除颜色End IfIf y1 <> 0 And y <> y1 Then Call 清除颜色: n = 0: y1 = 0: Exit SubIf n = 1 And y = y1 Then Target.Interior.ColorIndex = 6: x2 = x: y2 = y: n = n + 1: g = 1If n = 0 Then Target.Interior.ColorIndex = 6: x1 = x: y1 = y: n = n + 1: g = 1ActiveSheet.ProtectEnd IfEnd SubPrivate Sub 初始()n = 0: x1 = 0: x2 = 0: y1 = 0: y2 = 0: g = 0Call 清除颜色End SubPrivate Sub 清除颜色()Range("a2:a7").Interior.ColorIndex = xlNoneRange("d2:d7").Interior.ColorIndex = xlNoneEnd SubSub 过河()If n = 0 Then MsgBox "请选择成员": Exit SubActiveSheet.Unprotect '撤消保护q = q + 1: Range("b9") = "第 " & q & " 步"If n = 1 ThenIf Cells(x1, y1) = "" Then MsgBox "请选择成员": Exit SubIf y1 = 1 Then Call yd(x1, 8, 1): Call 清除颜色If y1 = 4 Then Call yd(x1, 8, -1): Call 清除颜色End IfIf n = 2 ThenIf x1 = 0 Or x2 = 0 Or Cells(x1, y1) = "" Or Cells(x2, y2) = "" Then MsgBox "请选择成员": Exit SubIf y2 = 1 Then Call yd(x1, x2, 1): Call 清除颜色If y2 = 4 Then Call yd(x1, x2, -1): Call 清除颜色End IfCall 初始If fx = 1 Thenfx = -1: ScrollArea = "$D1:$D7": t = "请从 B 岸选择成员"Elsefx = 1: ScrollArea = "$A1:$A7": t = "请从 A 岸选择成员"End IfRange("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 '保护End SubPrivate Sub yd(x1, x2, fx)If fx = 1 Theny = 1For i = 1 To 3Cells(x1, y + 1) = Cells(x1, y): Cells(x1, y) = ""Cells(x2, y + 1) = Cells(x2, y): Cells(x2, y) = ""y = y + 1: Call 延时NextElsey = 4For i = 1 To 3Cells(x1, y - 1) = Cells(x1, y): Cells(x1, y) = ""Cells(x2, y - 1) = Cells(x2, y): Cells(x2, y) = ""y = y - 1: Call 延时NextEnd IfEnd SubPrivate Sub 延时()For i = 1 To 50000000: NextEnd SubSub 重新开始()ActiveSheet.Unprotect '撤消保护Sheets("手动").Selectq = 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 '保护End Sub
8、给按钮指定宏用鼠标右键选中上面添加的“初始化”按钮，蒉翟蛳庹从弹出的快捷菜单中选“指定宏”，在弹出的宏窗口中选择“重新开始”宏，确定。吹涡皋陕用鼠标右键选中上面添加的“过河”按钮，从弹出的快捷菜单中选“指定宏”，在弹出的宏窗口中选择“过河”宏，确定。
9、完成这样就完成了，可以开始游戏了。回到EXCEL窗口，先用鼠标点击“初始化”按钮，再用鼠标选择一至两个过河成员后，按“过河”按钮就可以游戏了。在游戏过程中如果失败或胜利会有提示。