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

最后分享几个迷宫图片。