[VBA]ウラムの螺旋を作る[2/2]

前回ウラムの螺旋の前段階として、素数判定のプログラムを書きましたね。
今回は、数をらせん状に並べていくプログラムと、素数に色を塗っていくプログラムを書いていきましょう。

先にプログラムから

Option Explicit
'ウラムの螺旋マクロ'
Sub Ulam_Spiral()

Dim dir1, dir2, piyo As Integer
Dim i, x, y As Integer

Application.ScreenUpdating = False
'画面クリア'
Cells.Delete Shift:=xlUp

'ベクトルパラメータ2'
dir2 = 1
'番号'
i = 1
'初期座標'
x = 10
y = 10

'開始'
Do
    'ベクトルパラメータ1'
    For dir1 = 1 To 2
        For piyo = 1 To dir2
            '入力処理'
            Cells(y, x) = i
            If (primaryNumber(i)) Then
                Call DrowColor(y, x)
            End If
            '数を増加'
            i = i + 1
            '次の移動方向を取得'
            If (dir1 Mod 2 = 1 And dir2 Mod 2 = 1) Then
                x = x + 1
            ElseIf (dir1 Mod 2 = 0 And dir2 Mod 2 = 1) Then
                y = y - 1
            ElseIf (dir1 Mod 2 = 1 And dir2 Mod 2 = 0) Then
                x = x - 1
            ElseIf (dir1 Mod 2 = 0 And dir2 Mod 2 = 0) Then
                y = y + 1
            End If
        Next piyo
        '終了判定'
        If (validate(y, x) = False) Then
            Exit Do
        End If
    Next dir1
    dir2 = dir2 + 1
Loop
Application.ScreenUpdating = True
End Sub
'終了判定'
Private Function validate(y, x) As Boolean
If (x <= 0 Or y <= 0) Then
    validate = False
Else
    validate = True
End If

End Function

'素数判定'
Public Function primaryNumber(num) As Boolean
Dim i As Integer

'1'
If (num <= 1) Then
    primaryNumber = False
    Exit Function
End If

'偶数'
If (num = 2) Then
    primaryNumber = True
    Exit Function
ElseIf (num Mod 2 = 0) Then
    primaryNumber = False
    Exit Function
End If

'奇数チェック'
primaryNumber = True
For i = 3 To Math.Sqr(num) Step 2
    If (num Mod i = 0) Then
        primaryNumber = False
        Exit Function
    End If
Next i
End Function

'色を塗る'
Private Sub DrowColor(y, x)
    Cells(y, x).Interior.Color = RGB(200, 200, 200)
End Sub

説明していきます。

まず最初

Application.ScreenUpdating = False

これは画面描画を止めるというコマンドです。
このため、実行中画面は動きませんがその分処理を早く実行してくれます。

まず、並べ方なんですが、ウラムの螺旋の並びの規則性を考えていきます。

図のように、1進んだら反時計回りに回転、1進んだら反時計回りに回転、2進んだら反時計回りに回転…
という風に、直線の長さが1,1,2,2,3,3,4,4と増加していきます。

これをループで表現すると以下のようになります。
以下、無限ループ注意

dir2 = 1
i = 1
'開始'
Do
    'ベクトルパラメータ1'
    For dir1 = 1 To 2
        For piyo = 1 To dir2
            '#ここに処理を書いていく#'
             i = i + 1
        Next piyo
        dir2 = dir2 + 1
    Next dir1
Loop

これで以下のような対応になっていると思います。
（iは上図と一致させるようずらしています。）

また、次にどちらの方向に進むか、ですがこれは、dir1 と dir2 で取得できます。
方向との対応は以下の図で表されるため

以下IF文を追加します

            '次の移動方向を取得'
            If (dir1 Mod 2 = 1 And dir2 Mod 2 = 1) Then
                x = x + 1
            ElseIf (dir1 Mod 2 = 0 And dir2 Mod 2 = 1) Then
                y = y - 1
            ElseIf (dir1 Mod 2 = 1 And dir2 Mod 2 = 0) Then
                x = x - 1
            ElseIf (dir1 Mod 2 = 0 And dir2 Mod 2 = 0) Then
                y = y + 1
            End If

最後に、このままだと無限ループになってしまうので、次の座標がエクセルからはみ出たら終了するメソッドを書いていきます。

'終了判定'
Private Function validate(y, x) As Boolean
If (x <= 0 Or y <= 0) Then
    validate = False
Else
    validate = True
End If

以上で完成です。
今回、

'初期座標'
x = 10
y = 10

となっていますが、
xとyの値を増やしてあげればもっと巨大なウラムの螺旋が書けます。