いももちのきもち

新米プログラマによる技術的メモ

Excel VBAでライフゲームっぽいもの

Excel VBAを後輩に教える機会があって、後輩が作業している間につくったもの
大きくないフィールドなので、特にアルゴリズム上の工夫もなく、愚直にすべてのセルについて周りの8セルの状態を調べた。

最初に端以外の領域に適当に1を入れておき、適当な回数LifeGame()を実行する。
LifeGame()内でForループが実行されるたびにメッセージボックスが出力される(MsgBoxの代わりにスリープ機能を使うためには冒頭の文が必要である)。
1を入れたセルは条件付き書式設定により赤く表示するようにしている。

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub LifeGame()

For I = 0 To 7
    Call Count
    'Sleep 500
    MsgBox "Next"
Next I
End Sub

Sub Count()
Dim Arr(100) As Integer

For I = 0 To 9
    For J = 0 To 9
    If Cells(I + 1, J + 1) = 1 Then
        Arr(10 * I + J) = 1
    Else
        Arr(10 * I + J) = 0
    End If
    Next J
Next I

For I = 0 To 9
    valCnt = 0
    For J = 0 To 9
        If 0 < I And I < 9 And 0 < J And J < 9 Then
            valCnt = Arr((I - 1) * 10 + J) + Arr((I + 1) * 10 + J) + Arr((I - 1) * 10 + J - 1) + Arr((I + 1) * 10 + J - 1) + Arr((I * 10) + J - 1) + Arr((I - 1) * 10 + J + 1) + Arr((I + 1) * 10 + J + 1) + Arr((I * 10) + J + 1)
            If valCnt = 3 Or valCnt = 4 Then
                Cells(I + 1, J + 1) = 1
                Arr(10 * I + J) = 1
            Else
                Arr(10 * I + J) = 0
                'Cells(I + 1, J + 1) = 0
            End If
        End If
    Next J
Next I

End Sub

f:id:toricor:20160418180108p:plain