VBAで生存ゲームをやってみた

Excel

Excelでゲームをしてみたい

お仕事をするうえでは役に立たないかもしれませんが、

身近にあるエクセルでゲームが作れたらいいですよね。

今回は「生存ゲーム」というタイトルで作ってみました。

基本的にはこちらのサイトを参考にさせていただきました。

エクセルVBAで人工生命を作る

こちらのサイトではコードもすべて記載されており、

コピー・アンド・ペーストでも動作しましたので、簡単に試してみることができました。

私が実験する際にも「変数名」などそのまま使用させていただきました。

変更点は範囲を小さくして、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

こんな感じです。選択範囲の値を削除しています。

コピペで動きますが、数値をいじるだけでも、

条件分岐やループの勉強になりますね。

コメント

タイトルとURLをコピーしました