生活是一场游戏-玩吧

我还没有用Excel制作游戏，所以我决定制作Conway的《人生游戏》。 />目前，它非常初级（没有用户界面，没有按钮/控件，没有自动滴答作响），但是我希望在将来添加所有上述内容。甚至可以使其无限（在Excel的大小限制允许的范围内）。

屏幕截图：

工作原理：100x100的单元格网格。单元格从不显示值。 “ 1” =有效，其他任何值=无效。条件格式使所有“ 1”单元格变黑。 Ctrl + Shift + N递增1个滴答，Ctrl + Shift + R随机（50/50）重新填充网格。

我想知道的是，这是一个基于

享受！

模块C1_Increment_Tick

Option Explicit

Private CellArrayThisTick As Variant
Private CellArrayNextTick As Variant

Private CellRange As Range

Private Const XLength As Long = 100
Private Const YLength As Long = 100

Public Sub IncrementTick()

    StoreApplicationSettings

    DisableApplicationSettings

    Dim firstRow As Long, finalRow As Long
    Dim firstCol As Long, finalCol As Long
    firstRow = 1
    firstCol = 1
    finalRow = firstRow + (XLength - 1)
    finalCol = firstCol + (YLength - 1)

    Dim startCell As Range, finalCell As Range
    With ws_Simulation_Output
        Set startCell = .Cells(firstRow, firstCol)
        Set finalCell = .Cells(finalRow, finalCol)
    End With

    Set CellRange = ws_Simulation_Output.Range(startCell, finalCell)

    CellArrayThisTick = CellRange
    CellArrayNextTick = getCellArrayNextTick(CellArrayThisTick)

    CellRange.Cells.ClearContents
    CellRange = CellArrayNextTick

    RestoreApplicationSettings

End Sub

Public Function getCellArrayNextTick(ByRef thisTickArray As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    AssignArrayBounds thisTickArray, LB1, UB1, LB2, UB2

    Dim isAlive As Boolean, willBeAliveNextTick As Boolean
    Dim numNeighbours As Long

    Dim nextTickArray As Variant, nextTickValue As Long
    nextTickArray = Array()
    ReDim nextTickArray(LB1 To UB1, LB2 To UB2)

    Dim ix As Long, iy As Long
    Dim x As Long, y As Long

    Dim xStart As Long, xEnd As Long
    Dim yStart As Long, yEnd As Long

    Dim currentvalue As Variant

    '/ From the perspective of the next-tick array:
    For ix = LB1 To UB1
        For iy = LB2 To UB2
            xStart = ix - 1
            xEnd = ix + 1
            yStart = iy - 1
            yEnd = iy + 1

            If xStart < LB1 Then xStart = LB1
            If yStart < LB2 Then yStart = LB2
            If xEnd > UB1 Then xEnd = UB1
            If yEnd > UB2 Then yEnd = UB2

            numNeighbours = 0
            For x = xStart To xEnd
                For y = yStart To yEnd
                    currentvalue = thisTickArray(x, y)
                    If x <> y Then
                        If currentvalue = 1 Then numNeighbours = numNeighbours + 1
                    Else
                        isAlive = (currentvalue = 1)
                    End If
                Next y
            Next x

            willBeAliveNextTick = DetermineNextTickState(isAlive, numNeighbours)

            If willBeAliveNextTick Then
                nextTickValue = 1
            Else
                nextTickValue = 0
            End If

            nextTickArray(ix, iy) = nextTickValue
        Next iy
    Next ix

    getCellArrayNextTick = nextTickArray

End Function

Public Function DetermineNextTickState(ByVal isAlive As Boolean, ByVal numNeighbours As Long) As Boolean

    Dim result As Boolean

    If isAlive Then
        If numNeighbours = (2 Or 3) Then
            result = True
        Else
            result = False
        End If
    Else
        If numNeighbours = 3 Then result = True
    End If

    DetermineNextTickState = result

End Function

Public Sub RandomFill()

    StoreApplicationSettings

    DisableApplicationSettings

    ws_Simulation_Output.Activate
    ws_Simulation_Output.Cells.ClearContents

    Dim row As Long, col As Long

    For row = 1 To XLength
        For col = 1 To YLength
            If Rnd() > 0.5 Then Cells(row, col) = 1
        Next col
    Next row

    RestoreApplicationSettings

End Sub

numNeighbours =（2或3）对3正确，对其他所有数字都为假... => 2或3为3 ...我想你想要numNeighbours = 2或numNeighbours = 3;）

#1 楼

您始终需要知道要去哪里。动作不应太多。如果您要为不同的动作设置不同的功能（这是一件好事），则它们应该是“独立的”。。像这样的东西

Private Const XLength As Long = 100
Private Const YLength As Long = 100

，您只需要得到数组大小即可。现在有了

AssignArrayBounds thisTickArray, LB1, UB1, LB2, UB2

在这里对我来说没有意义。只是浪费资源。

具有“可以更改”或“不能更改”的功能

firstRow = 1
firstCol = 1

它们是1。如果您真的打算更改起点，为什么不将它们设置为全局？

“搜索”。您应该始终有1个“范围”可以完成所有设置。

看看

Private Const firstRow As Long = 1
Private Const firstCol As Long = 1

您浪费了很多时间！为什么要检查yi循环内部是否在xi循环外部？

For ix = LB1 To UB1
    For iy = LB2 To UB2
        xStart = ix - 1
        xEnd = ix + 1
        yStart = iy - 1
        yEnd = iy + 1

        If xStart < LB1 Then xStart = LB1
        If yStart < LB2 Then yStart = LB2
        If xEnd > UB1 Then xEnd = UB1
        If yEnd > UB2 Then yEnd = UB2

或者甚至更好地直接跳过它：高度”，然后是“宽度”，我建议您在窗口中使用“宽度”。（但是，在某些情况下这是不可避免的，我们也没有在谈论它）。

虽然没什么好看的，但是在您的随机填充中使用了：

For ix = LB1 To UB1
  xStart = ix - 1
  xEnd = ix + 1
  If xStart < LB1 Then xStart = LB1
  If xEnd > UB1 Then xEnd = UB1

  For iy = LB2 To UB2
    yStart = iy - 1
    yEnd = iy + 1
    If yStart < LB2 Then yStart = LB2
    If yEnd > UB2 Then yEnd = UB2

对我来说，这看起来很容易理解。从1到设置范围。但是看着那些选择LBound / UBound的东西，我的头想记住“它有多大？”或“有什么特别的地方吗？”
此外，这样一来，计算量就减少了。与使用For row = firstRow to XLength并运行“ LBx”和AssignArrayBounds相比，甚至UBx都更容易“理解” ...

谈论您的LB和UB。您总是在谈论“易于理解的符号”。拥有可见的2D表，您可以考虑一下并使用它，如下所示：

For ix = LB1 To UB1
  If ix = LB1 Then xStart = ix Else xStart = ix - 1 'skip row over range
  If ix = UB1 Then xEnd = ix Else xEnd = ix + 1     'skip row below range

  For iy = LB2 To UB2
    If iy = LB1 Then yStart = iy Else yStart = iy - 1 'skip column left of range
    If iy = UB1 Then yEnd = iy Else yEnd = iy + 1     'skip column right of range

这样，每个人都可以一眼知道这里发生了什么。

最后，您使用了Dim row As Long。 Row是一个属性，不应声明为变量。

简单：需要执行的计算越少，您可以添加的越多:)

不过，您仍然需要知道要去哪里，以避免尽可能多的计算。

但是，在对旧硬盘进行长时间搜索之后，我才能够找到我的旧硬盘几年前的代码（我几乎不记得它以不同的方式工作）。
我只是在其中添加了一些注释（我保留了所有其他内容，所以请不要抱怨名称或类似的东西那）：P
希望您对此项目或其他一些项目有一个或两个想法。

For row = 1 To XLength
    For col = 1 To YLength
        If Rnd() > 0.5 Then Cells(row, col) = 1
    Next col
Next row

\ $ \ begingroup \ $
那里有很多很棒的建议，欢呼。
\ $ \ endgroup \ $
–卡兹
15年12月22日在17:51

\ $ \ begingroup \ $
另外，您应该在某些时候聊天。
\ $ \ endgroup \ $
–卡兹
15年12月22日在18:17

#2 楼

错误的逻辑

Dirk Reichel提出了一个很好的观点，即DetermineNextTickState的逻辑表达不正确，应该为If numNeighbours = 2 Or numNeighbours = 3。

此外，这是：

                If x <> y Then
                    If currentvalue = 1 Then numNeighbours = numNeighbours + 1
                Else
                    isAlive = (currentvalue = 1)
                End If

将导致完全错误的结果（当单元格位于x / y对角线上时，它甚至不具有所需的语义）。我将其重写为：

    For ix = LB1 To UB1
        If ix = LB1 Or ix = UB1 Then xLimit = 2 Else xLimit = 3 '/ Constrain limits on edge cases
        For iy = LB2 To UB2
            If iy = LB2 Or iy = UB2 Then yLimit = 2 Else yLimit = 3

            xStart = ix - 1
            xEnd = ix + 1
            yStart = iy - 1
            yEnd = iy + 1

            If xStart < LB1 Then xStart = LB1
            If yStart < LB2 Then yStart = LB2
            If xEnd > UB1 Then xEnd = UB1
            If yEnd > UB2 Then yEnd = UB2

            numNeighbours = 0
            For x = 1 To xLimit
                xPos = x + (xStart - 1) '/ new xPos/yPos variables
                For y = 1 To yLimit
                    yPos = y + (yStart - 1)

                    currentvalue = thisTickArray(xPos, yPos)
                    If xPos <> ix Or yPos <> iy Then
                        If currentvalue = 1 Then numNeighbours = numNeighbours + 1
                    Else
                        isAlive = (currentvalue = 1)
                    End If
                Next y
            Next x

            willBeAliveNextTick = DetermineNextTickState(isAlive, numNeighbours)

            If willBeAliveNextTick Then
                nextTickValue = 1
            Else
                nextTickValue = 0
            End If

            nextTickArray(ix, iy) = nextTickValue
        Next iy
    Next ix

编程黑洞网

生活是一场游戏-玩吧

评论

#1 楼

评论

#2 楼