Excelでゲームをしてみたい
お仕事をするうえでは役に立たないかもしれませんが、
身近にあるエクセルでゲームが作れたらいいですよね。
今回は「生存ゲーム」というタイトルで作ってみました。
基本的にはこちらのサイトを参考にさせていただきました。
こちらのサイトではコードもすべて記載されており、
コピー・アンド・ペーストでも動作しましたので、簡単に試してみることができました。
私が実験する際にも「変数名」などそのまま使用させていただきました。
変更点は範囲を小さくして、Sheet1,Sheet2で対戦形式にし、
随時色を変更したり、動作ボタンを追加した感じでしょうか。
どんなものか動画で見てみましょう
激しいアクションを期待していたらごめんなさい・・・
何をしているかというと、最初の色付きセルを基準に、
- 誕生・・死んでいるセルに隣接する生きたセルがちょうど3つあれば、次の世代が誕生する。
- 生存・・生きているセルに隣接する生きたセルが2つか3つならば、次の世代でも生存する。
- 過疎・・生きているセルに隣接する生きたセルが1つ以下ならば、過疎により死滅する。
- 過密・・生きているセルに隣接する生きたセルが4つ以上ならば、過密により死滅する。
といったことが行われています。
VBAのコードはこのような感じです。
Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
'全体ルール
'誕生・・・死んでいるセルに隣接する生きたセルがちょうど3つあれば、次の世代が誕生する。
'生存・・・生きているセルに隣接する生きたセルが2つか3つならば、次の世代でも生存する。
'過疎・・・生きているセルに隣接する生きたセルが1つ以下ならば、過疎により死滅する。
'過密・・・生きているセルに隣接する生きたセルが4つ以上ならば、過密により死滅する。
Sub lifegame()
Dim col As Integer
Dim row As Integer
col = 1
row = 1
Dim table() As Variant
ReDim table(1 To 30) As Variant
table = Range(Cells(1, 1), Cells(30, 30)).Value
Dim table2(1 To 30, 1 To 30) As Variant
Dim currentState As Integer
Dim numberOfNeighbor As Integer
Dim generation As Integer
generation = 1
For generation = 1 To 200
For col = 1 To 30
For row = 1 To 30
currentState = table(row, col)
If col = 1 Then
If row = 1 Then
numberOfNeighbor = table(row + 1, col) + table(row, col + 1) + table(row + 1, col + 1)
ElseIf row >= 2 And row <= 29 Then
numberOfNeighbor = table(row - 1, col) + table(row - 1, col + 1) + table(row, col + 1) + table(row + 1, col + 1) + table(row + 1, col)
ElseIf row = 30 Then
numberOfNeighbor = table(row - 1, col) + table(row - 1, col + 1) + table(row, col + 1)
End If
ElseIf col >= 2 And col <= 29 Then
If row = 1 Then
numberOfNeighbor = table(row, col - 1) + table(row, col + 1) + table(row + 1, col - 1) + table(row + 1, col) + table(row + 1, col + 1)
ElseIf row >= 2 And row <= 29 Then
numberOfNeighbor = table(row - 1, col - 1) + table(row - 1, col) + table(row - 1, col + 1) + table(row, col - 1) + table(row, col + 1) + table(row + 1, col - 1) + table(row + 1, col) + table(row + 1, col + 1)
ElseIf row = 30 Then
numberOfNeighbor = table(row, col - 1) + table(row, col + 1) + table(row - 1, col - 1) + table(row - 1, col) + table(row - 1, col + 1)
End If
ElseIf col = 30 Then
If row = 1 Then
numberOfNeighbor = table(row, col - 1) + table(row + 1, col - 1) + table(row + 1, col)
ElseIf row >= 2 And row <= 29 Then
numberOfNeighbor = table(row - 1, col) + table(row - 1, col - 1) + table(row, col - 1) + table(row + 1, col - 1) + table(row + 1, col)
ElseIf row = 30 Then
numberOfNeighbor = table(row - 1, col) + table(row - 1, col - 1) + table(row, col - 1)
End If
End If
If currentState = 1 Then
If numberOfNeighbor = 3 Or numberOfNeighbor = 2 Then
table2(row, col) = 1
Else
table2(row, col) = 0
End If
ElseIf currentState = 0 Then
If numberOfNeighbor = 3 Then
table2(row, col) = 1
Else
table2(row, col) = 0
End If
End If
Next row
Next col
Range(Cells(1, 1), Cells(30, 30)).Value = table
Sleep 10
table = table2
Next generation
Cells(32, 2) = "生き残ったのは" & WorksheetFunction.CountIf(Range("B2:AN39"), 1) & "個体"
End Sub
参考にしたコードからの変更点として、まずは動作範囲
元のコードは100セル間で動作するようになっていますが、
Dim table() As Variant
ReDim table(1 To 100) As Variant
table = Range(Cells(1, 1), Cells(100, 100)).Value
Dim table2(1 To 100, 1 To 100) As Variant
私はパソコンの画面から飛び出ないように30セル間で動作するようにしています。
Dim table() As Variant
ReDim table(1 To 30) As Variant
table = Range(Cells(1, 1), Cells(30, 30)).Value
Dim table2(1 To 30, 1 To 30) As Variant
それに伴って、コード内の100はすべて30にするわけですが、
99となっている部分は29とするのをお忘れなく。
そして34行目あたりの、For generation = 1 To 200の部分ですが、
もとは1 To 100で100世代分となっています。
この部分は単純にループの回数ですので、数字を増やすと長い時間動いてくれます。
そして、私は表の下に生き残り数を表示させています。
その部分が94行目あたりのコードです。
Cells(32, 2) = "生き残ったのは" & WorksheetFunction.CountIf(Range("B2:AN39"), 1) & "個体"
セル32行2列目に、日本語で「生き残ったのは○○個体です」と表示させています。
“”で日本語を囲んで、&でコードとつないでいます。
コードの内容は、WorksheetFunctionでエクセル関数のCountIfを使用して、
「1」の入力数を数えています。
Excel側の準備
まずはマスを正方形にしたいです。だいたいでいいです。
行列の角の部分を選択すると一括操作ができます。
そして、「ホーム→書式」から行列の幅を設定してください。
同じ設定のExcelSheetを2つ作ります。
シートの名前は、player1,player2とします。
シート名は何でもいいですが、ここでは対戦相手を開くコードで、
player2という名前を使っていますので、コードと名前をそろえてください。
枠線や表の周りの色はExcelの「ホーム」から設定してください。
そして、「1」を入力すると色が変わるようにするには、条件付き書式を使用します。
「A1からAD30」を選択してExcel「ホーム」→「条件付き書式」と進みます。
「新しいルール」を選択して、下図のように設定します。
- 指定の値を含むセルだけを書式設定
- セルの値
- 次の値に等しい
- =1
- プレビューの「書式」から、フォントの色や背景の色を設定します。
実は空白部分には「0」が表示されますので、
「0」も条件付き書式でフォントの色「白」背景「白」
に設定します。
ボタンの作成
マクロを実行するためのボタンを作成します。
まずは、Sheet「player1」に「対戦相手を開く」ボタンを作成します。
コードはこんな感じです。
Sub 対戦者()
ActiveWindow.NewWindow
Sheets("player2").Select
Windows.Arrange ArrangeStyle:=xlTiled
End Sub
Sheet「player2」を選択し、並べて表示させています。
ボタンはExcelの「開発者タブ」→「挿入」で図形を挿入し、
「対戦者」を選択します。
ボタンのタイトルは図形をクリックして書き換えます。
スタートボタンは、上記の「lifegame」のコードです。
クリアボタンのコードは
Sub クリア()
Range("A1:AN40", "B32").Select
Selection.ClearContents
Range("B2").Select
End Sub
こんな感じです。選択範囲の値を削除しています。
コピペで動きますが、数値をいじるだけでも、
条件分岐やループの勉強になりますね。
コメント