'「Excelでライフゲーム」のメインコードです。
'ソフトではWin32APIのSleepを使用していますが、このコードではApplication.Waitで代用しています。
'ソフトでは、セル範囲[A1:CV100]に条件付き書式を設定し、値が1であれば色がつくようにしています。
'///宣言セクション///
Public varArea As Variant, varEmpty As Variant

Type CellsStatus
    x As Long: y As Long   'セルの位置
    v As Long              '隣接セル数格納
    ys As Long: ye As Long '隣接セル行格納
    xs As Long: xe As Long '隣接セル列格納
End Type

Public cs() As CellsStatus

Sub Initial_Setting_Rnd() 'セルをランダムに配置
    Dim i As Long, j As Long
    Randomize
    With Range("A1:CV100")
        .ClearContents
        varArea = .Value
        For i = 1 To 100
            For j = 1 To 100
                If Int(Rnd() * 10) < 4 Then varArea(i, j) = 1
            Next
        Next
        .Value = varArea
    End With
End Sub

Sub Area_Clear()        '範囲をクリア
    Range("A1:CV200").ClearContents
End Sub

Sub LifeGame_Main()     'ライフゲームメイン
    Call Next_Generation(30) '30世代おくる。数値を変更するとおくる世代数を変更できます。
                             '数値は最大100程度に。あまりに大きいとコンピュータに負荷がかかります
End Sub

Private Sub Next_Generation(ByVal c As Long) '次世代処理サブルーチン
    Dim i As Long
    If Value_Setting() Then          '配置確認関数
        MsgBox "セルの数が0です。セルを配置してください。", vbExclamation: Exit Sub
    End If
    For i = 1 To c
        If Stage_Set() Then
            MsgBox "セルは死滅しました。", vbInformation: Exit Sub
        End If
        Application.Wait [Now() + "0:00:00.1"]
    Next
End Sub

Private Function Value_Setting() As Boolean '配置確認関数
    Dim i As Long, j As Long, c As Long
    Erase cs
    varArea = Range("A1:CV100").Value
    varEmpty = Range("A101:CV200").Value
    For i = 1 To 100
        For j = 1 To 100
            If varArea(i, j) = 1 Then
                c = c + 1
                ReDim Preserve cs(1 To c)
                cs(c).y = i: cs(c).x = j
            Else
                varArea(i, j) = Empty
            End If
        Next
    Next
    Value_Setting = CBool(c = 0)
End Function

Private Function Stage_Set() As Boolean '次世代処理メイン関数
    Dim i As Long, j As Long, k As Long, c As Long, varBk As Variant
    Dim myCS() As CellsStatus
    varBk = varEmpty
    For i = LBound(cs) To UBound(cs)
        With cs(i)
            If .y = 1 Then .ys = 1 Else .ys = .y - 1
            If .y = 100 Then .ye = 100 Else .ye = .y + 1
            If .x = 1 Then .xs = 1 Else .xs = .x - 1
            If .x = 100 Then .xe = 100 Else .xe = .x + 1
            For j = .ys To .ye
                For k = .xs To .xe
                    If Not (j = .y And k = .x) Then
                        If varArea(j, k) = 1 Then
                            .v = .v + 1 '隣接セル数カウント
                        Else
                            varBk(j, k) = varBk(j, k) + 1 '隣接セルに+1
                        End If
                    End If
                Next
            Next
            If .v = 2 Or .v = 3 Then    '現世代の生き残り確認
                .v = 0
                c = c + 1
                ReDim Preserve myCS(1 To c)
                myCS(c) = cs(i)
            End If
        End With
    Next
    For i = LBound(cs) To UBound(cs)    '次世代誕生確認
        With cs(i)
            For j = .ys To .ye
                For k = .xs To .xe
                    If varBk(j, k) = 3 Then
                        varBk(j, k) = 0
                        c = c + 1
                        ReDim Preserve myCS(1 To c)
                        myCS(c).y = j: myCS(c).x = k
                    End If
                Next
            Next
        End With
    Next
    cs = myCS
    varArea = varEmpty
    If 0 < c Then
        For i = LBound(cs) To UBound(cs) '生き残り＋次世代セット
            varArea(cs(i).y, cs(i).x) = 1
        Next
    End If
    Range("A1:CV100").Value = varArea
    Stage_Set = CBool(c = 0)
End Function