迷路ネコが影分身の術を体得したら…
ツイッターで迷路を解くVBAが流行っていたので、ネコを迷路に挑戦させてみた・・・
さすがに壁登りで迷路クリアは、、、
ということで、ちゃんと迷路を攻略するようにネコを調教しました。
ツイート
まうにゃんは厳しい躾けの末、居眠りも壁登りもせずに進むようになった。
さらに必死の修行を重ねて、ついに「影分身」の術を体得した。
突き当りに行った分身は「ボン」と消える。
ゴールに着いた分身が道順を知らせてくれる。
https://twitter.com/yamaoka_ss/status/1541074715329982470
ネコの絵文字
VBAソースコード
VBAコードの書き方等も、あまり推奨できるような書き方にはなっていません。
Public変数を多用したり、クラス内のMe.の使い方等、ざっと書いたままになっています。
また、変数名も日本語でそのまま書いていたりしています。
以上の点はご承知おきください。
クラスモジュール：clsMaunyan
Option Explicit
Public 状態 As e状態
Public 現在位置 As Range
Public 前回位置 As Range
Public 迷路 As Range
Public routeRange As Range
Public Sub 位置について(ByVal rng As Range)
Set 前回位置 = rng
Set 現在位置 = rng
Call setにゃん1(rng)
Set routeRange = rng
End Sub
Public Function 進め() As Boolean
進め = False
Select Case 状態
Case e状態.突き当り
現在位置.Value = ""
状態 = e状態.終了
Exit Function
Case e状態.終了
Exit Function
End Select
If 現在位置 Is Nothing Or 前回位置 Is Nothing Or 迷路 Is Nothing Then
MsgBox "にゃあ"
Exit Function
End If
Dim 方向(1 To 4) As Variant
方向(1) = 進行判定(現在位置.Offset(-1, 0))
方向(2) = 進行判定(現在位置.Offset(0, 1))
方向(3) = 進行判定(現在位置.Offset(0, -1))
方向(4) = 進行判定(現在位置.Offset(1, 0))
Dim i As Long
For i = 1 To 4
If 方向(i)(2) = e進行.ゴール Then
Call setにゃん1(方向(i)(1))
Sleep 500
routeRange.Value = sにゃん1
進め = True
Exit Function
End If
Next
Dim iNext As Long
For i = 1 To 4
If 方向(i)(2) = e進行.進路 Then
If iNext = 0 Then
iNext = i
Else
colNyan.Add CloneMe(現在位置, 方向(i)(1))
End If
End If
Next
If iNext = 0 Then
状態 = 突き当り
現在位置.Value = sにゃん2
Exit Function
End If
Call setにゃん1(方向(iNext)(1))
Set routeRange = Union(routeRange, 方向(iNext)(1))
End Function
Private Function 進行判定(ByVal rng As Range) As Variant
Dim rtnAry(1 To 2)
Set rtnAry(1) = rng
If Intersect(rng, 迷路) Is Nothing Then
rtnAry(2) = e進行.範囲外
GoTo Exit01
End If
If rng.Address = 前回位置.Address Then
rtnAry(2) = e進行.戻る
GoTo Exit01
End If
Select Case rng.Value
Case "Start": rtnAry(2) = e進行.スタート
Case "Goal": rtnAry(2) = e進行.ゴール
Case ""
If rng.Interior.Color = vbBlack Then
rtnAry(2) = e進行.壁だ
Else
rtnAry(2) = e進行.進路
End If
End Select
Exit01:
進行判定 = rtnAry
End Function
Private Sub setにゃん1(ByVal rng As Range)
Set 前回位置 = 現在位置
前回位置.Value = ""
Set 現在位置 = rng
現在位置.Value = sにゃん1
現在位置.Font.Color = vbRed
End Sub
Private Sub Class_Initialize()
状態 = e状態.進行中
End Sub
Private Function CloneMe(ByVal a現セル As Range, ByVal a次セル As Range) As clsMaunyan
Set CloneMe = New clsMaunyan
With CloneMe
Set .迷路 = Me.迷路
.位置について a次セル
Set .前回位置 = a現セル
Set .routeRange = Union(routeRange, a次セル)
End With
End Function
標準モジュール
Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public sにゃん1 As String
Public sにゃん2 As String
Public colNyan As Collection
Public Enum e状態
進行中 = 0
突き当り = 1
終了 = 2
ゴール = 9
End Enum
Public Enum e進行
スタート = 0
進路 = 1
戻る = 2
壁だ = 3
ゴール = 9
範囲外 = 99
End Enum
Sub main()
sにゃん1 = Worksheets("文字").Range("A1")
sにゃん2 = Worksheets("文字").Range("A2")
Set colNyan = New Collection
Dim cls As New clsMaunyan
With Range("D2:AR38")
.ClearContents
.Range("A2").Value = "Start"
.Range("A2").Font.ColorIndex = xlAutomatic
.Item(.Count).Offset(-1).Value = "Goal"
.Item(.Count).Offset(-1).Font.ColorIndex = xlAutomatic
Set cls.迷路 = .Cells
End With
Sleep 500
Call cls.位置について(cls.迷路.Cells(2, 2))
colNyan.Add cls, cls.現在位置.Address
Dim v
Do
For i = colNyan.Count To 1 Step -1
Set v = colNyan(i)
If v.状態 = e状態.終了 Then
Set v = Nothing
colNyan.Remove i
Else
If v.進め Then Exit Do
End If
Next
DoEvents
Sleep 50
Loop
End Sub
同じテーマ「ツイッター出題回答 」の記事
ツイッターで出されたVBAのお題（悪魔のCSV）をやってみた
「VBAで導関数を求めよ」ツイッターのお題をやってみた
ツイッターのお題「君の名は？」
ツイッターのお題「CSV編集」
アルファベットの26進（ツイッターお題）
ナンバープレート数字遊び：ツイッターお題
サロゲートペアに対応した自作関数（Len,Left,Mid,Right）
迷路にネコが挑戦したら、どうなるかな…
迷路ネコが影分身の術を体得したら…
VBAで漢数字を算用数字に変換
新着記事NEW ・・・新着記事一覧を見る
WshNetwork（ネットワークドライブの割り当て等）｜VBA技術解説(2025-04-09)
TRANSLATE関数（翻訳） DETECTLANGUAGE関数（言語識別）｜エクセル入門(2025-04-08)
QRコード、バーコード作成の覚え書き｜エクセル関数応用(2025-04-05)
TRIMRANGE関数（セル範囲をトリム：端の空白セルを除外）｜エクセル入門(2024-08-30)
正規表現関数（REGEXTEST,REGEXREPLACE,REGEXEXTRACT）｜エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない｜エクセル雑感(2024-04-11)
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ひらがな⇔カタカナの変換｜エクセル基本操作
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
10.条件分岐（Select Case）｜VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。