龙空技术网

excel宏关于迷宫全部代码

GGGGWHW 91

前言:

当前小伙伴们对“迷宫程序代码数据结构”大概比较关怀,朋友们都需要剖析一些“迷宫程序代码数据结构”的相关文章。那么小编也在网摘上搜集了一些对于“迷宫程序代码数据结构””的相关文章,希望我们能喜欢,小伙伴们一起来学习一下吧!

  下面分享一下迷宫的全部宏代码,虽然运行速度不快,但是好在可以正常运行。

  其中两个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

最后分享几个迷宫图片。

标签: #迷宫程序代码数据结构 #迷宫求解数据结构设计完整代码