迷路ネコが影分身の術を体得したら…
ツイッターで迷路を解く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 ・・・新着記事一覧を見る
IMPORTCSV関数（CSVファイルのインポート）｜エクセル入門(2026-01-19)
IMPORTTEXT関数（テキストファイルのインポート）｜エクセル入門(2026-01-19)
料金表（マトリックス）から金額で商品を特定する｜エクセル練習問題(2026-01-14)
「緩衝材」としてのVBAとRPA｜その終焉とAIの台頭｜エクセル雑感(2026-01-13)
シンギュラリティ前夜：AIは機械語へ回帰するのか｜生成AI活用研究(2026-01-08)
電卓とプログラムと私｜エクセル雑感(2025-12-30)
VLOOKUP/XLOOKUPが異常なほど遅くなる危険なアンチパターン｜エクセル関数応用(2025-12-25)
2段階の入力規則リスト作成：最新関数対応｜エクセル関数応用(2025-12-24)
IFS関数をVBAで入力するとスピルに関係なく「@」が付く現象について｜VBA技術解説(2025-12-23)
数値を記号の積み上げでグラフ化する（■は10、□は1）｜エクセル練習問題(2025-12-09)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
7.繰り返し処理（For Next)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.条件分岐（Select Case）｜VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.