アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

A 回答 (1件)

このままの形を残して作ると無駄が多すぎるのと、画面表示が遅すぎるので、多少変更、削除しました。


コードはWorkbookに貼り付ける事を前提に作ってあります。
選択済み以外のセルをクリックするとスタートします。

ルールはWikiの内容を参考にしました。BORNとLIFEの値(0~8の範囲)を変更するとパターンも変わります。

http://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4% …

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
    • good
    • 0
この回答へのお礼

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

お礼日時:2011/06/28 17:24

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!