x = 25 y = 25 Cells(x, y).Select G = True Do While G = True Randomize a = Int(Rnd * 8) If x > 1 And y > 1 Then If a = 1 Then x = x - 1 y = y - 1 Cells(x, y).Select Selection.Value = "●" ElseIf a = 2 Then x = x - 1 y = y Cells(x, y).Select Selection.Value = "●" ElseIf a = 3 Then x = x - 1 y = y + 1 Cells(x, y).Select Selection.Value = "●" ElseIf a = 4 Then x = x + 1 y = y - 1 Cells(x, y).Select Selection.Value = "●" ElseIf a = 5 Then x = x + 1 y = y Cells(x, y).Select Selection.Value = "●" ElseIf a = 0 Then
Cells(x, y).Select Selection.Value = "●" ElseIf a = 6 Then x = x + 1 y = y + 1 Cells(x, y).Select Selection.Value = "●" ElseIf a = 7 Then x = x y = y + 1 Cells(x, y).Select Selection.Value = "●" End If End If If x > 49 Or y > 49 Then x = 0 y = 0 x = Int(Rnd * 48) + 1 y = Int(Rnd * 48) + 1 Cells(x, y).Select Selection.Value = "●" ElseIf x <= 1 Or y <= 1 Then x = 0 y = 0 x = Int(Rnd * 48) + 1 y = Int(Rnd * 48) + 1 Cells(x, y).Select Selection.Value = "●" End If Sleep (i) Loop End Sub
Public Sub Main()
On Error GoTo ErrorHandler
Application.EnableCancelKey = xlErrorHandler
Dim X As Long: Dim Y As Long: Dim Temp As Long
LifeArea = Range(Cells(1, 1), Cells(SIZE_X, SIZE_Y)) '画面上のデータを取得
Select Case MsgBox("ランダムパターンを作成しますか?" & vbCr & _
"「いいえ」で現在画面の続きを実行します。" & vbCr & _
"(実行中、停止するにはESCキーを押してください。)", _
vbYesNoCancel + vbInformation, "実行開始")
Case vbYes 'ランダムパターン作成
Randomize
For X = 1 To SIZE_X: For Y = 1 To SIZE_Y
LifeArea(X, Y) = Abs(Rnd() * 10 < 5)
Next: Next
Case vbNo 'エラーデータ補正
For X = 1 To SIZE_X: For Y = 1 To SIZE_Y
If LifeArea(X, Y) <> 1 Then LifeArea(X, Y) = 0
Next: Next
Case vbCancel: Exit Sub '終了
End Select
Do 'メイン処理
LifeNext = LifeArea
For X = 1 To SIZE_X: For Y = 1 To SIZE_Y
If LifeArea(X, Y) Then
Temp = LivesCount(X, Y)
If Temp = 2 Then
ElseIf Temp = 3 Then
Else: LifeNext(X, Y) = 0 '生→死
End If
Else
If LivesCount(X, Y) = 3 Then LifeNext(X, Y) = 1 '空→発生
End If
Next: Next
Range(Cells(1, 1), Cells(SIZE_X, SIZE_Y)) = LifeNext '画面更新
LifeArea = LifeNext '次処理準備
Call Sleep(WAIT)
DoEvents
Loop
ErrorHandler:
End Sub
Private Function LivesCount(X As Long, Y As Long) As Long
LivesCount = 0
If GetData(X - 1, Y - 1) Then LivesCount = LivesCount + 1
If GetData(X - 1, Y) Then LivesCount = LivesCount + 1
If GetData(X - 1, Y + 1) Then LivesCount = LivesCount + 1
If GetData(X, Y - 1) Then LivesCount = LivesCount + 1
If GetData(X, Y + 1) Then LivesCount = LivesCount + 1
If GetData(X + 1, Y - 1) Then LivesCount = LivesCount + 1
If GetData(X + 1, Y) Then LivesCount = LivesCount + 1
If GetData(X + 1, Y + 1) Then LivesCount = LivesCount + 1
End Function
Private Function GetData(X As Long, Y As Long) As Long
On Local Error GoTo OutOfRange
GetData = LifeArea(X, Y): Exit Function
OutOfRange:
Err = 0: GetData = 0
End Function