エクセル方眼紙とVBAでライフゲーム

ライフゲーム - Wikipedia
https://ja.wikipedia.org/wiki/%E3%83%A9%E3%82%A4%E3%83%95%E3%82%B2%E3%83%BC%E3%83%A0

ライフゲームの基本ルール

誕生周囲に生存セルがちょうど3つあれば誕生

生存周囲に生存セルが2個か3個あれば生き残る

消滅上記以外の場合消滅

セルを使うなんてエクセルにピッタリじゃん

ってことで紙ってるエクセル方眼紙とVBAで試してみた

http://www.geocities.jp/gogowaten/lifegame01.gif

エクセル方眼紙は神エクセルじゃなくて糸氏エクセルだからセーフ

自分の周り8個のセルを調べて、生存セルの個数を数える

周りのセルの座標は自分から-1から1ズレたところにあるから

Offset関数を使う

塗りつぶし黒はColorIndexが1

なので

基準になる自分のセルを渡すと周りのセルで黒のセルの個数を返す関数

'周りの8セルを探査、黒のセルの個数を返す
Function SearchCell(r As Range) As Long
Dim c As Long
For y = -1 To 1
For x = -1 To 1
If r.Offset(x, y).Interior.ColorIndex = 1 Then
If Not (x = 0 And y = 0) Then '自身はカウントしない
c = c + 1
End If
End If
Next
Next
SearchCell = c
End Function

下準備として

使うシートは2枚、名前をlifegameA, lifegameBにした

使うセル範囲は20ｘ20で、名前を付けてそれぞれmapA, mapBにした

シートlifegameA

操作したり表示用

シートlifegameBは探索用(判定用)

流れ

mapAをmapBにコピー
mapBで目標の周囲のセルを探査
結果からmapAのセルを書き換える
目標のセルを次のセルにする
2番に戻る(最後のセルまで繰り返し)

コード全部

'次の世代へ更新
Sub NextGeneration()
    Application.ScreenUpdating = False
    '判定用シート(lifegameB)にコピー
    Range("mapA").Copy Range("mapB")
    
    Dim ci As Long 'colorIndex
    Dim sr As Long 'searchResult
    For y = 1 To 20
        For x = 1 To 20
            Dim rb As Range
            Set rb = Range("mapB").Cells(x, y)
            ci = rb.Interior.ColorIndex
            sr = SearchCell(rb) '周囲のセルを探査
            If ci = xlColorIndexNone And sr = 3 Then
                '周囲の生存セル数が3なら誕生
                Range("mapA").Cells(x, y).Interior.ColorIndex = 1
            ElseIf ci = 1 And (sr = 2 Or sr = 3) Then
                '周囲の生存セル数が2か3なら生存
                Range("mapA").Cells(x, y).Interior.ColorIndex = 1
            Else
                '上記以外なら消滅
                Range("mapA").Cells(x, y).Interior.ColorIndex = xlColorIndexNone
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

'周りの8セルを探査、黒のセルの個数を返す
Function SearchCell(r As Range) As Long
    Dim c As Long
    For y = -1 To 1
        For x = -1 To 1
            If r.Offset(x, y).Interior.ColorIndex = 1 Then
                If Not (x = 0 And y = 0) Then '自身はカウントしない
                    c = c + 1
                End If
            End If
        Next
    Next
    SearchCell = c
End Function

Sub initial初期配置()
    Dim r As Range
    Set r = Range("mapA")
    r.Interior.ColorIndex = xlColorIndexNone
    Dim rr As Range
    For Each rr In r
        Randomize
        If Rnd < 0.3 Then '0.2なら約2割のセルを黒で塗る
            rr.Interior.ColorIndex = 1
        End If
    Next
End Sub

'全セル塗りつぶしなし
Sub ClearLifegameA()
    Worksheets("lifegameA").Activate
    Range("mapA").Interior.ColorIndex = xlColorIndexNone
End Sub

f:id:gogowaten:20191030133133p:plain

適当な図形を挿入してそれに実行するマクロを登録

初期配置ボタンを押したところ

全体の3割が黒になる、3割か4割がいい感じに次世代につながる

8割、9割だと次世代で全滅とかになるｗ

次世代へボタンを押すと

こうなる

このとき探索用シートは前世代の状態になっているはずのlifegameBを見ると

前世代の状態で残っている

http://www.geocities.jp/gogowaten/lifegame04.gif

誕生、生存、消滅の判定部分はムダというか冗長な所あるけど、まあいいや

気になるのが上下左右の辺のセルの処理

端だと外側は必ず生存なしのセルだから、なんか違う感じになるので

反対側とループさせたい

今回のエクセルファイル：ライフゲーム.xlsm
https://box.yahoo.co.jp/guest/viewer?sid=box-l-3rjuj7hqmqr7b3al3lvxcim3ku-1001&uniqid=6ad2c7f0-98b9-44d8-98d7-a2649bbcc386&viewtype=detail

つづきは4日後

gogowaten.hatenablog.com

エクセルVBAでライフゲームその2 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14606097.html

反対側と繋げてループできた