
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ベストアンサー
- 回答日時:
このままの形を残して作ると無駄が多すぎるのと、画面表示が遅すぎるので、多少変更、削除しました。
コードは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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
住民票のない居住地で国民健康...
-
エアメール(会社宛)の宛名の...
-
ご近所ワークって 住所や氏名が...
-
goo id の本人確認書類を変更し...
-
運転免許証の住所をあまり見せ...
-
引越しの度に変更届けを出しますか
-
愛知県での免許更新手続きと住...
-
職場での住所録
-
全部事項証明書で【表題部】の...
-
クロネコヤマトってBという住所...
-
事務所移転のご案内文の書き方...
-
会社宛の書留郵便の受け取り
-
起点住所とは何ですか? 赴任旅...
-
北海道の住所表記について
-
住所から、最寄り駅を楽に調べ...
-
15年ぶりに恩師と会話したい場...
-
メール署名作成
-
床屋で写真を見せてこんなふう...
-
英検の写真って・・・
-
アルバイト先で学生証の提示を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
表札に番地を入れる場合
-
北海道の住所表記について
-
会社宛の書留郵便の受け取り
-
住所をコロコロ変える会社
-
起点住所とは何ですか? 赴任旅...
-
エアメール(会社宛)の宛名の...
-
住民票のない居住地で国民健康...
-
パンフレットの正誤表(変更表...
-
口座番号で住所はばれる?
-
全部事項証明書で【表題部】の...
-
免許証の記載事項変更…について。
-
地域の商工会議所にお世話にな...
-
別居中の場合、派遣会社にはど...
-
免許証の住所変更について教え...
-
引っ越して3年になるのに旧住...
-
二級建築士の住所変更について...
-
試用期間中の一日休むことについて
-
免許証の住所変更と免許更新に...
-
メール署名作成
-
印鑑証明 内容変更
おすすめ情報