单元格值未显示

Question

很抱歉，代码量很大，但是没有它就无法复制。

我在excel中制作了一个蛇形游戏（相当令人讨厌），它创建了一个随机的“食物”单元格。直到10分以上的食物消失为止。我试图添加DoEvents似乎没有帮助。我还添加了很多双重调用，并进行了递归尝试以蛮横地将事物显示出来，这使其变得更好一些，但最终仍将消失。

无视我完全没有评论（或对我发怒，这是应得的。）

以下是制作食物的代码：

Public Sub createfood(Optional recurse As Boolean = True)
    Dim segment As Variant
    Application.ScreenUpdating = False
    If Not pfood Is Nothing Then
        pfood.Value = ""
    End If
    Dim rndrow As Long
    Dim rndcol As Long
    rndrow = (Int(25 * Rnd) + 2)
    rndcol = (Int(16 * Rnd) + 2)
    Set pfood = psheet.Cells(rndrow, rndcol)
    For Each segment In snake.body
       If snake.body(segment).Address = pfood.Address Then
          createfood
          Exit Sub
       End If
    Next
    DoEvents
    pfood.Value = 0
    If recurse = True Then
        createfood False
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

要重现此内容，您将需要工作表，模块和类代码。

工作表1-工作表代码：

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal target As Range)
    Dim intersection As Range
    Dim mouseclickdetection As Range
    Dim snakebodyobj As Object
    Dim snakebody As Range
    Dim segment As Variant

    Set intersection = Application.Intersect(target, snake.body(snake.body.Count).Offset(1, 0))
    If Not intersection Is Nothing Then
        direction = "Down"
    End If
    Set intersection = Application.Intersect(target, snake.body(snake.body.Count).Offset(-1, 0))
    If Not intersection Is Nothing Then
        direction = "Up"
    End If
    Set intersection = Application.Intersect(target, snake.body(snake.body.Count).Offset(0, 1))
    If Not intersection Is Nothing Then
        direction = "Right"
    End If
    Set intersection = Application.Intersect(target, snake.body(snake.body.Count).Offset(0, -1))
    If Not intersection Is Nothing Then
        direction = "Left"
    End If
    If movevar = True Then
        If Not snake Is Nothing Then
            If target.Address = snake.head.Address And snake.body.Count > 1 Then
                Module1.illegalmove
                Exit Sub
            End If
            If snake.body.Count = 1 Then
                Set mouseclickdetection = Union(snake.head.Offset(1, 0), snake.head.Offset(-1, 0), snake.head.Offset(0, 1), snake.head.Offset(0, -1), snake.head)
            Else
                Set mouseclickdetection = Union(snake.body(snake.body.Count).Offset(1, 0), snake.body(snake.body.Count).Offset(-1, 0), snake.body(snake.body.Count).Offset(0, 1), snake.body(snake.body.Count).Offset(0, -1), snake.body(snake.body.Count))
            End If
            Set intersection = Application.Intersect(target, mouseclickdetection)
            If intersection Is Nothing Then
                Module1.mouseclick
                Exit Sub
            End If
            Set intersection = Application.Intersect(target, snake.gamerange)
            If Not intersection Is Nothing Then
                Set snakebodyobj = snake.body
                For Each segment In snakebodyobj
                    If snakebody Is Nothing Then
                        Set snakebody = snakebodyobj(segment)
                    Else
                        Set snakebody = Union(snakebody, snakebodyobj(segment))
                    End If
                Next
                Set intersection = Application.Intersect(target, snakebody)
                If intersection Is Nothing Then
                    If snake.food.Address = target.Address Then
                        snake.movement target, True
                    Else
                        snake.movement target, False
                    End If
                    target.Interior.Color = RGB(100, 100, 100)
                Else
                    Module1.gameover
                    Exit Sub
                End If
            Else
                    Module1.gameover
                    Exit Sub
            End If
        End If
    Else
        Select Case direction
            Case "Down"
                target.Offset(-1, 0).Select
            Case "Up"
                target.Offset(1, 0).Select
            Case "Right"
                target.Offset(0, -1).Select
            Case "Left"
                target.Offset(0, 1).Select
        End Select
    End If

    Module1.toggle_movevar
    Debug.Print alerttime
    If alerttime = 0 Then
        alerttime = Now + TimeValue("00:00:02")
        Application.OnTime alerttime, "EventMacro"
    End If

End Sub

Module1-模块代码：

Option Explicit
Public snake As Cls_NewSnake
Public direction As String
Public alerttime As Date
Public movevar As Boolean


Sub start_snake(Optional recurse As Boolean = True)
    Dim gamerange As Range
    Dim startcell As Range
    Dim scorecell As Range
    Dim highscorecell As Range
    Application.EnableEvents = False
    Set gamerange = Range("B2:Q26")
    With gamerange.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With gamerange.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With gamerange.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With gamerange.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With

    gamerange.HorizontalAlignment = xlHAlignCenter
    gamerange.Interior.ColorIndex = 0
    gamerange.Value = ""
    With gamerange
        .Columns.ColumnWidth = 3
        .Rows.RowHeight = 12
    End With
    Set startcell = Cells(14, "I")
    startcell.Select
    startcell.Interior.Color = RGB(100, 100, 100)

    Set scorecell = Range("S1")
    Set highscorecell = Range("S3")
    scorecell.Value = 1
    scorecell.Offset(0, -1).Value = "Score"
    highscorecell.Offset(0, -1).Value = "High Score"

    scorecell.HorizontalAlignment = xlHAlignCenter
    scorecell.Offset(0, -1).HorizontalAlignment = xlHAlignCenter
    If snake Is Nothing Then
        Set snake = New Cls_NewSnake
    End If
    snake.initialize startcell, ActiveSheet, gamerange, scorecell, highscorecell
    startcell.Select
    Application.EnableEvents = True
    If recurse = True Then
        Module1.start_snake False
    End If
End Sub
Sub stopevents()
Application.EnableEvents = False
End Sub
Sub startevents()
Application.EnableEvents = True
End Sub

Sub gameover()
    MsgBox "You are donezo, resetting"
    direction = ""
    snake.gamerange.Value = ""
    snake.gamerange.Interior.ColorIndex = 0
    Module1.start_snake
    Application.EnableEvents = True
End Sub

Sub illegalmove()
    Dim newdir As Long
    Dim olddir As String
    olddir = direction
    newdir = (Int(4 * Rnd) + 1)

    Select Case newdir
        Case 1
            direction = "Up"
        Case 2
            direction = "Down"
        Case 3
            direction = "Left"
        Case 4
            direction = "Right"
    End Select
    If olddir = direction Then
        illegalmove
        Exit Sub
    End If
    MsgBox "Hey, you can't move into yourself. Randomizing the new direction. Good Luck."

    Application.EnableEvents = False
    snake.body(snake.body.Count).Select
    Application.EnableEvents = True
End Sub

Sub mouseclick()
    MsgBox "No one likes a dirty cheater"
    Application.EnableEvents = False
    snake.body(snake.body.Count).Select
    Application.EnableEvents = True
End Sub

Sub EventMacro()
    toggle_movevar True
    Select Case direction
        Case "Right"
            Selection.Offset(0, 1).Select
        Case "Left"
            Selection.Offset(0, -1).Select
        Case "Up"
            Selection.Offset(-1, 0).Select
        Case "Down"
            Selection.Offset(1, 0).Select
    End Select

    If Application.WorksheetFunction.CountA(snake.gamerange) = 0 Then
        snake.createfood
    End If

    'alerttime = Now + TimeValue("00:00:01")
    alerttime = Now + 0.0000059
    Application.OnTime alerttime, "EventMacro"

End Sub

Sub manualstart()
    Module1.start_snake
End Sub

Sub toggle_movevar(Optional ByVal toggle As Boolean = False)
    movevar = toggle
End Sub

Cls_NewSnake-类代码：

Option Explicit

Private psheet As Worksheet
Private plength As Long
Private pfood As Range
Private pbody As Object
Private pgamerange As Range
Private pscorecell As Range
Private phighscorecell As Range
Private phead As Range

Public Sub initialize(start As Range, sh As Worksheet, gamerange As Range, scorecell As Range, highscorecell As Range)
    Dim rndrow As Long
    Dim rndcol As Long
    Set psheet = sh
    Set pgamerange = gamerange
    Set pscorecell = scorecell
    Set phighscorecell = highscorecell
    plength = 1
    Set pbody = CreateObject("Scripting.Dictionary")
    pbody.Add 1, start
    Set phead = pbody(1)
    createfood
End Sub
Public Sub movement(newcell As Range, sizeup As Boolean)
    Dim i As Long
    Dim tempbody As Object
    Dim length As Long
    Set tempbody = pbody
    length = pbody.Count
    Set phead = pbody(plength)
    If sizeup = False Then
       pbody(1).Interior.ColorIndex = 0
        For i = 1 To (length)
            If Not (i = length) Then
                Set pbody(i) = tempbody(i + 1)
            End If
        Next i
        Set pbody(length) = newcell
        If pbody.Count > 1 Then
            Set phead = pbody(length - 1)
        Else
            Set phead = pbody(length)
        End If
    Else
        plength = plength + 1
        pbody.Add plength, newcell
        createfood
        pscorecell.Value = pscorecell.Value + 1
        If phighscorecell.Value < pscorecell.Value Then
            phighscorecell.Value = pscorecell.Value
        End If
        Set phead = pbody(plength - 1)
    End If
End Sub

Public Sub createfood(Optional recurse As Boolean = True)
    Dim segment As Variant
    Application.ScreenUpdating = False
    If Not pfood Is Nothing Then
        pfood.Value = ""
    End If
    Dim rndrow As Long
    Dim rndcol As Long
    rndrow = (Int(25 * Rnd) + 2)
    rndcol = (Int(16 * Rnd) + 2)
    Set pfood = psheet.Cells(rndrow, rndcol)
    For Each segment In snake.body
       If snake.body(segment).Address = pfood.Address Then
          createfood
          Exit Sub
       End If
    Next
    DoEvents
    pfood.Value = 0
    If recurse = True Then
        createfood False
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

Public Property Get food() As Range
    Set food = pfood
End Property

Public Property Get gamerange() As Range
    Set gamerange = pgamerange
End Property

Public Property Get body() As Object
    Set body = pbody
End Property

Public Property Get head() As Range
    Set head = phead
End Property

如果您希望它在启动时运行，通常会立即显示问题，然后将此代码放在工作簿模块中：

Private Sub Workbook_Open()
    Module1.start_snake
end sub