Excel VBAライフゲーム

質問

ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。
もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。
続きのプログラムを教えていただけたら幸いです。

Option Explicit

Const ALIVE As Integer = 1
Const DEAD As Integer = 0

Const SIZE As Integer = 19
Const Tmax As Integer = 100

Dim C(SIZE, SIZE) As Integer

Sub LifeGame()
Dim InitRate As Single
Dim T As Integer
Dim N As Integer
Dim Cnext(SIZE, SIZE) As Integer
Dim I As Integer, J As Integer

InitRate = -1
Do While InitRate < 0 Or 1 < InitRate
Loop

For I = 0 To SIZE
For J = 0 To SIZE
If Rnd() < InitRate Then
C(I, J) = ALIVE
Else
C(I, J) = DEAD
End If
Next J
Next I

For T = 1 To Tmax

For I = 0 To SIZE
For J = 0 To SIZE
If C(I, J) = ALIVE Then
Cells(I + 1, J + 1).Value = "■"
Else
Cells(I + 1, J + 1).Vallue = ""
End If
Next J
Next I

For I = 0 To SIZE
For J = 0 To SIZE
N = Count(I, J)

Next J
Next I

For I = 0 To SIZE
For J = 0 To SIZE
C(I, J) = Cnext(I, J)
Next J
Next I

Next T

End Sub

Function Count(I As Integer, J As Integer) As Integer

End Function

回答No.1

OKWavetamotsu · ベストアンサー

このままの形を残して作ると無駄が多すぎるのと、画面表示が遅すぎるので、多少変更、削除しました。
コードはWorkbookに貼り付ける事を前提に作ってあります。
選択済み以外のセルをクリックするとスタートします。

ルールはWikiの内容を参考にしました。ＢＯＲＮとＬＩＦＥの値（０～８の範囲）を変更するとパターンも変わります。

http://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0

Option Explicit

Const ALIVE As Integer = 1
Const DEAD As Integer = 0
Const BORN As Integer = 3　'加筆
Const LIFE As Integer = 2　'加筆

Const SIZE As Integer = 20　'19を20に変更
Const Tmax As Integer = 100

Dim C(SIZE, SIZE) As Integer
Dim Xrange As Variant　'加筆

Private Sub LifeGame() 　　'Private
Dim InitRate As Single
Dim T As Integer
'Dim N As Integer　不要
'Dim Cnext(SIZE, SIZE) As Integer　不要
Dim I As Integer, J As Integer

Randomize　'加筆
Xrange = Range("A1:T20")　'加筆

InitRate = 0.5　 '-1を0.5に変更
'Do While InitRate < 0 Or 1 < InitRate　不要
'Loop

For I = 1 To SIZE 　 '初期値0を1に変更
For J = 1 To SIZE 　 '初期値0を1に変更
If Rnd() < InitRate Then
C(I, J) = ALIVE
Else
C(I, J) = DEAD
End If
Next J
Next I

For T = 1 To Tmax

For I = 1 To SIZE　 '初期値0を1に変更
For J = 1 To SIZE 　 '初期値0を1に変更
If C(I, J) = ALIVE Then
Xrange(I, J) = "■"　 '訂正
Else
Xrange(I, J) = ""　'訂正
End If
Next J
Next I

Range("A1:T20") = Xrange　'加筆

' For I = 0 To SIZE 　 不要
' For J = 0 To SIZE
' N = Count(I, J)
' Next J
' Next I

For I = 1 To SIZE　 '初期値0を1に変更
For J = 1 To SIZE 　 '初期値0を1に変更
C(I, J) = Cnext(I, J)
Next J
Next I

Next T

End Sub

Function Cnext(I As Integer, J As Integer) As Integer　 'Function名変更
Dim xi As Integer
Dim xj As Integer
Dim xsum As Integer

For xi = I - 1 To I + 1
For xj = J - 1 To J + 1
If (xi > 0 And xi <= SIZE) _
And (xj > 0 And xj <= SIZE) Then
If Not (xi = I And xj = J) Then
If C(xi, xj) = ALIVE Then
xsum = xsum + 1
End If
End If
End If
Next
Next

Select Case xsum
Case BORN
Cnext = ALIVE
Case LIFE
Cnext = C(I, J)
Case Else
Cnext = DEAD
End Select

End Function

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call LifeGame
End Sub

お礼

詳しく教えていただきありがとうございました。