下面分享一下迷宫的全部宏代码，虽然运行速度不快，但是好在可以正常运行。
其中两个function和一个sub是用来调用的。shang、xia、zuo、you四个sub的代码几乎相同，并且都会调用aaranse，用来表示按键操作时，角色向哪个方向移动。migong用来生成新的迷宫地图，要调用两个function，其中ffkaimen用来表示生成迷宫时打开两个单元格之间的通道；ffxinbianjie用来刷新已完成的迷宫边界。kaishi用来表示手动操作角色通过迷宫正式开始了。快捷键能够起作用的前提是，先录制宏，设置好快捷键，然后将这里每一个宏里的代码复制到录制好的对应的宏里面去。
Option Explicit
Sub shang()
'
' shang 宏
'
' 快捷键: Ctrl+w
'
Dim HH1, LL1, ii, jj, Hj1, Lj1 As Long
HH1 = ActiveSheet.UsedRange.Rows.Count
LL1 = ActiveSheet.UsedRange.Columns.Count
Hj1 = -1
Lj1 = 0
For jj = 2 To LL1
For ii = 2 To HH1
If Cells(ii, jj).Interior.Color = RGB(255, 0, 255) And _
Cells(ii, jj).Borders(xlEdgeTop).LineStyle = xlNone And _
Cells(ii + Hj1, jj + Lj1).Borders(xlEdgeBottom).LineStyle = xlNone Then
Call aaRanse(ii, jj, Hj1, Lj1)
GoTo Jieshu
End If
Next ii
Next jj
Jieshu:
End Sub
Sub xia()
'
' xia 宏
'
' 快捷键: Ctrl+s
Dim HH1, LL1, ii, jj, Hj1, Lj1 As Long
HH1 = ActiveSheet.UsedRange.Rows.Count
LL1 = ActiveSheet.UsedRange.Columns.Count
Hj1 = 1
Lj1 = 0
For jj = 2 To LL1
For ii = 2 To HH1
If Cells(ii, jj).Interior.Color = RGB(255, 0, 255) And _
Cells(ii, jj).Borders(xlEdgeBottom).LineStyle = xlNone And _
Cells(ii + Hj1, jj + Lj1).Borders(xlEdgeTop).LineStyle = xlNone Then
Call aaRanse(ii, jj, Hj1, Lj1)
GoTo Jieshu
End If
Next ii
Next jj
Jieshu:
End Sub
Sub zuo()
'
' zuo 宏
'
' 快捷键: Ctrl+a
'
Dim HH1, LL1, ii, jj, Hj1, Lj1 As Long
HH1 = ActiveSheet.UsedRange.Rows.Count
LL1 = ActiveSheet.UsedRange.Columns.Count
Hj1 = 0
Lj1 = -1
For jj = 2 To LL1
For ii = 2 To HH1
If Cells(ii, jj).Interior.Color = RGB(255, 0, 255) And _
Cells(ii, jj).Borders(xlEdgeLeft).LineStyle = xlNone And _
Cells(ii + Hj1, jj + Lj1).Borders(xlEdgeRight).LineStyle = xlNone Then
Call aaRanse(ii, jj, Hj1, Lj1)
GoTo Jieshu
End If
Next ii
Next jj
Jieshu:
End Sub
Sub you()
'
' you 宏
'
' 快捷键: Ctrl+d
'
Dim HH1, LL1, ii, jj, Hj1, Lj1 As Long
HH1 = ActiveSheet.UsedRange.Rows.Count
LL1 = ActiveSheet.UsedRange.Columns.Count
Hj1 = 0
Lj1 = 1
For jj = 2 To LL1
For ii = 2 To HH1
If Cells(ii, jj).Interior.Color = RGB(255, 0, 255) And _
Cells(ii, jj).Borders(xlEdgeRight).LineStyle = xlNone And _
Cells(ii + Hj1, jj + Lj1).Borders(xlEdgeLeft).LineStyle = xlNone Then
Call aaRanse(ii, jj, Hj1, Lj1)
GoTo Jieshu
End If
Next ii
Next jj
Jieshu:
End Sub
Sub migong()
'
' migong 宏
'
' 快捷键: Ctrl+m
'
Application.ScreenUpdating = False '屏幕不及时更新
Application.DisplayAlerts = False '警告不显示
On Error GoTo tuichu '出现错误 GoTo tuichu
Cells.Delete
Cells.Interior.Color = RGB(190, 190, 0)
Cells.RowHeight = 14.25
Cells.ColumnWidth = 1.88
Dim HH1, LL1, ii, jj, HH2, LL2, LL0, HH0 As Long
Dim Bianjie As String
Dim Rnd1, Weizhi1, Hang1, Lie1, Fangxiang1 As Long
Dim Rukou1, Chukou1 As Long
Bianjie = ""
'Bianjie每9位一组,其中234位表示行号,678位表示列号,第9位表示门的方向1下2左3右4上
LL0 = 4 '起始列
HH0 = 4 '起始行
HH1 = 24 '行数
LL1 = 44 '列数
HH2 = HH1 + HH0 - 1 '末尾列
LL2 = LL1 + LL0 - 1 '末尾列
'边框设为0,
For ii = HH0 - 2 To HH2 + 2
For jj = LL0 - 2 To LL2 + 2
Cells(ii, jj) = 0
Next jj
Next ii
'内部设为2
For ii = HH0 To HH2
For jj = LL0 To LL2
Cells(ii, jj) = 4
Next jj
Next ii
With Range(Cells(HH0, LL0), Cells(HH2, LL2))
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Interior.Color = RGB(0, 0, 0)
End With
'入口设为1
jj = Int(Rnd() * HH1 + HH0)
Cells(jj, LL0 - 1) = 1
Bianjie = FFKaimen(jj, LL0 - 1, 3, Bianjie)
Rukou1 = jj
For ii = 1 To 999999
If Bianjie = "" Then
Exit For
End If
Rnd1 = Int(Exp(Log(Rnd()) * 0.3) * Len(Bianjie) / 9)
Weizhi1 = Mid(Bianjie, Rnd1 * 9 + 1, 8)
Hang1 = Val(Mid(Weizhi1, 1, 4)) - 1000
Lie1 = Val(Mid(Weizhi1, 5, 4)) - 1000
Fangxiang1 = Mid(Bianjie, Rnd1 * 9 + 9, 1)
Bianjie = FFKaimen(Hang1, Lie1, Fangxiang1, Bianjie)
Bianjie = FFXinBianjie(Bianjie)
Next
'画出口
jj = Int(Rnd() * HH1 + HH0)
Cells(jj, LL2).Borders(xlEdgeRight).LineStyle = xlNone
Chukou1 = jj
Cells.ClearContents
Cells(Rukou1, LL0 - 1) = "→"
Cells(Chukou1, LL2 + 1) = "→"
Cells(Rukou1, LL0 - 2).Select
Range(Cells(HH0 - 2, LL0), Cells(HH0 - 2, LL2)).Merge
With Cells(HH0 - 2, LL0)
.Value = HH1 & "×" & LL1 & "的迷宫"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Size = 18
.EntireRow.AutoFit
End With
If Len(Cells(1, 1)) = 0 Then
Cells(1, 1) = " "
End If
tuichu:
Application.ScreenUpdating = True '屏幕更新
Application.DisplayAlerts = True '警告显示
End Sub
Sub kaishi()
'
' kaishi 宏
'
' 快捷键: Ctrl+k
'
Dim HH1, LL1, Hj1, Lj1, ii, jj As Long
HH1 = ActiveSheet.UsedRange.Rows.Count
LL1 = ActiveSheet.UsedRange.Columns.Count
Hj1 = 0
Lj1 = 1
For jj = 1 To LL1
For ii = 1 To HH1
If Cells(ii, jj) = "→" Then
Range(Cells(ii - 1, jj + 1), Cells(ii + 1, jj + 1)).Interior.Color = RGB(255, 255, 255)
Cells(ii, jj).Interior.Color = RGB(255, 0, 255)
GoTo Jixu
End If
Next ii
Next jj
Jixu:
For jj = LL1 - 2 To LL1
For ii = 1 To HH1
If Cells(ii, jj) = "→" Then
Cells(ii, jj).Interior.Color = RGB(255, 255, 255)
GoTo Jieshu
End If
Next ii
Next jj
Jieshu:
End Sub
Function FFXinBianjie(Bianjie)
Dim FH1, FL1, FH2, FL2, FX1, FX2, ii, jj As Integer
Dim Bianjie2 As String
Bianjie2 = Bianjie
ii = Len(Bianjie2) / 9
Do While ii > 0
FH1 = Val(Mid(Bianjie2, ii * 9 - 8, 4)) - 1000
FL1 = Val(Mid(Bianjie2, ii * 9 - 4, 4)) - 1000
FX1 = Val(Mid(Bianjie2, ii * 9, 1))
FH2 = FH1
FL2 = FL1
FX2 = 5 - FX1
If FX1 = 1 Then
FH2 = FH1 + 1
ElseIf FX1 = 2 Then
FL2 = FL1 - 1
ElseIf FX1 = 3 Then
FL2 = FL1 + 1
ElseIf FX1 = 4 Then
FH2 = FH1 - 1
End If
jj = Len(Bianjie2) / 9 - 1
Do While jj > 0
If Mid(Bianjie2, jj * 9 - 8, 9) = "" & (1000 + FH2) & (1000 + FL2) & FX2 Then
Bianjie2 = "" & Left(Bianjie2, (jj - 1) * 9) & Mid(Bianjie2, jj * 9 + 1, Len(Bianjie2))
Exit Do
End If
jj = jj - 1
Loop
If Cells(FH2, FL2) < 4 Then
Bianjie2 = "" & Left(Bianjie2, (ii - 1) * 9) & Mid(Bianjie2, ii * 9 + 1, Len(Bianjie2))
End If
ii = ii - 1
Loop
FFXinBianjie = Bianjie2
End Function
Function FFKaimen(Hang, Lie, Fangxiang, Bianjie)
Dim Bianjie2, Shanchu1 As String
Dim Hang2, Lie2, ii As Long
Bianjie2 = Bianjie
Cells(Hang, Lie) = Cells(Hang, Lie) - 1
Shanchu1 = "" & (1000 + Hang) & (1000 + Lie) & Fangxiang
ii = Len(Bianjie2) / 9
For ii = Len(Bianjie2) / 9 To 1 Step -1
If Mid(Bianjie2, ii * 9 - 8, 9) = Shanchu1 Then
Bianjie2 = "" & Left(Bianjie2, (ii - 1) * 9) & Mid(Bianjie2, ii * 9 + 1, Len(Bianjie2))
End If
Next
Hang2 = Hang
Lie2 = Lie
If Fangxiang = 1 Then
Cells(Hang, Lie).Borders(xlEdgeBottom).LineStyle = xlNone
Hang2 = Hang + 1
ElseIf Fangxiang = 2 Then
Cells(Hang, Lie).Borders(xlEdgeLeft).LineStyle = xlNone
Lie2 = Lie - 1
ElseIf Fangxiang = 3 Then
Cells(Hang, Lie).Borders(xlEdgeRight).LineStyle = xlNone
Lie2 = Lie + 1
ElseIf Fangxiang = 4 Then
Cells(Hang, Lie).Borders(xlEdgeTop).LineStyle = xlNone
Hang2 = Hang - 1
End If
Cells(Hang2, Lie2) = Cells(Hang2, Lie2) - 1
If Cells(Hang2 + 1, Lie2) = 4 Then
Bianjie2 = Bianjie2 & (1000 + Hang2) & (1000 + Lie2) & 1
End If
If Cells(Hang2, Lie2 - 1) = 4 Then
Bianjie2 = Bianjie2 & (1000 + Hang2) & (1000 + Lie2) & 2
End If
If Cells(Hang2, Lie2 + 1) = 4 Then
Bianjie2 = Bianjie2 & (1000 + Hang2) & (1000 + Lie2) & 3
End If
If Cells(Hang2 - 1, Lie2) = 4 Then
Bianjie2 = Bianjie2 & (1000 + Hang2) & (1000 + Lie2) & 4
End If
FFKaimen = Bianjie2
End Function
Sub aaRanse(ii, jj, Hj1, Lj1)
Dim Jj1 As Integer
If Hj1 = 0 Then
For Jj1 = -1 To 1
If Cells(ii + Jj1, jj + 2 * Lj1).Interior.Color = RGB(0, 0, 0) Then
Cells(ii + Jj1, jj + 2 * Lj1).Interior.Color = RGB(255, 255, 255)
End If
Next
ElseIf Lj1 = 0 Then
For Jj1 = -1 To 1
If Cells(ii + 2 * Hj1, jj + Jj1).Interior.Color = RGB(0, 0, 0) Then
Cells(ii + 2 * Hj1, jj + Jj1).Interior.Color = RGB(255, 255, 255)
End If
Next
End If
If Cells(ii + Hj1, jj + Lj1).Interior.Color = RGB(255, 255, 255) Or _
Cells(ii + Hj1, jj + Lj1).Interior.Color = RGB(190, 190, 190) Then
Cells(ii, jj).Interior.Color = RGB(0, 255, 0)
Cells(ii + Hj1, jj + Lj1).Interior.Color = RGB(255, 0, 255)
ElseIf Cells(ii + Hj1, jj + Lj1).Interior.Color = RGB(0, 255, 0) Then
Cells(ii, jj).Interior.Color = RGB(190, 190, 190)
Cells(ii + Hj1, jj + Lj1).Interior.Color = RGB(255, 0, 255)
End If
End Sub
最后分享几个迷宫图片。
