excel宏关于迷宫全部代码

　　下面分享一下迷宫的全部宏代码，虽然运行速度不快，但是好在可以正常运行。
　　其中两个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
　　最后分享几个迷宫图片。