【VBA】風来のシレンのフロアの最短経路を求める

### 【概要】
2020/03/26にNintendo Switchで風来のシレン5が発売されることが決定しました。
この報告を受けて嬉しさのあまり、フロアの最短経路を求めるプログラムを書きました。

### 【環境】
Windows8.1
Excel 2013

### 【注意点】
本プログラムはフロア全体の把握および、ゴール（階段など次のフロアに移動する場所）が分からなければ最短経路を求めることができません。
風来のシレン5はやったことがないので、フロア全体やゴールが分かるようなアイテムがあるのかは不明です。
そのため本プログラムは使い物にならない可能性がありますが、ゲームが楽しめれば良いのです。

### 【コード】

```vb
Option Explicit

Sub main()
    Dim start As Range
    Dim goal As Range

    ' Sを探す
    Set start = Cells.Find("S")
    ' Gを探す
    Set goal = Cells.Find("G")

    Call breadthFirstSearch(start)
    Call paintShortestPath(goal)
End Sub


' 幅優先探索
Sub breadthFirstSearch(start As Range)
    Dim i As Integer
    Dim j As Integer
    Dim nowRange As Range
    Dim q As mscorlib.Queue
    Set q = CreateObject("System.Collections.Queue")
    Call q.Enqueue(start)
    
    ' 最短距離計算のためスタート地点の値を一時的に数値に変更する
    start.Value = 0
    
    Do While q.Count <> 0
        Set nowRange = q.Dequeue
        ' 現在のセルの周り9セルに対して探索を行う
        For i = -1 To 1
            For j = -1 To 1
                If Cells(nowRange.row + i, nowRange.Column + j).Value = "" _
                    And Cells(nowRange.row + i, nowRange.Column + j).Interior.ColorIndex <> xlNone _
                    And canDiagonalMovement(nowRange, i, j) Then
                        Call q.Enqueue(Cells(nowRange.row + i, nowRange.Column + j))
                        Cells(nowRange.row + i, nowRange.Column + j).Value = nowRange.Value + 1
                End If
            Next
        Next
    Loop
    
    ' 数値に変更されたスタート地点の値を元に戻す
    start.Value = "S"
End Sub

' 斜め移動できるか判定
Function canDiagonalMovement(nowRange As Range, rowIndex As Integer, colIndex As Integer) As Boolean
    If (Cells(nowRange.row, nowRange.Column + colIndex).Interior.ColorIndex <> xlNone _
        And Cells(nowRange.row + rowIndex, nowRange.Column).Interior.ColorIndex <> xlNone) Then
        canDiagonalMovement = True
    Else
        canDiagonalMovement = False
    End If
End Function

' ゴール地点から距離の小さい座標を求め、スタート地点にたどり着くまでの最短経路を
' 黄色塗りつぶしにする
Sub paintShortestPath(goal As Range)
    Dim i As Integer
    Dim j As Integer
    Dim nowRange As Range
    Dim minDistance As Integer: minDistance = 10000
    Dim q As mscorlib.Queue
    Set q = CreateObject("System.Collections.Queue")
    Call q.Enqueue(goal)
    
    ' ゴール地点の周り9セルから距離の最小値を求める
    For i = -1 To 1
        For j = -1 To 1
            If Cells(goal.row + i, goal.Column + j).Value <> "" _
                And Cells(goal.row + i, goal.Column + j).Value < minDistance Then
                    minDistance = Cells(goal.row + i, goal.Column + j).Value
            End If
        Next
    Next
    
    ' 最短距離計算のためゴール地点の値を一時的に数値に変更する
    goal.Value = minDistance + 1

    Do While q.Count <> 0
        Set nowRange = q.Dequeue
        ' 現在のセルの周り9セルに対して探索を行う
        For i = -1 To 1
            For j = -1 To 1
                If Cells(nowRange.row + i, nowRange.Column + j).Value <> "" _
                    And canDiagonalMovement(nowRange, i, j) _
                    And Cells(nowRange.row + i, nowRange.Column + j).Value < nowRange.Value _
                    And Cells(nowRange.row + i, nowRange.Column + j).Interior.Color <> rgbYellow Then
                        Call q.Enqueue(Cells(nowRange.row + i, nowRange.Column + j))
                        Cells(nowRange.row + i, nowRange.Column + j).Interior.Color = rgbYellow
                End If
            Next
        Next
    Loop
    
    ' 数値に変更されたゴール地点の値を元に戻す
    goal.Value = "G"
End Sub
```

### 【実行準備】
①黄色以外の好きな色で好きなようにフロアを作ります。
　フロア以外は塗りつぶさないようにして下さい。
　A列と1行目は塗りつぶさないようにして下さい。
②スタート(S)とゴール(G)を決めます。

![実行準備.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/121997/636e22c9-9a9a-0d81-b407-e8b01bef2229.png)




### 【実行結果】
スタートから各地点の最短距離が書き込まれます。
スタートからゴールまでの最短経路が黄色で塗りつぶされます。

![実行結果.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/121997/2a7a88a5-a482-aabb-893a-8d07b0c3c87a.png)


### 【参考書籍・サイト】
[プログラミングコンテスト攻略のためのアルゴリズムとデータ構造](https://book.mynavi.jp/ec/products/detail/id=35408)
[VBAで.NET FrameworkのQueueを使う](https://vbabeginner.net/vba%E3%81%A7-net-framework%E3%81%AEqueue%E3%82%92%E4%BD%BF%E3%81%86/)