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