循环以检查SelectionChange事件中目标地址和周围地址中的数组值

时间:2016-03-24 15:35:37

标签: arrays excel-vba minesweeper vba excel

我目前正在编写扫雷编码,但我无法解决问题。 当发现的单元格为空(意味着没有我的旁边)时,所有与此相邻的单元格以及彼此相邻的单元格也必须被发现。

我在数组中生成了网格的值和地雷,并使用SelectionChange事件来发现一个单元格。它会检查此地址中我的数组中的值是否为""如果是,我选择周围的单元格来循环事件并发现这个单元格。它似乎是一种奇怪的方法,但我找不到别的东西。 当我的游戏网格相对较小时,这种方法很好,但是当它很大时,它停在某些位置并且不会发现每个单元格。

我使用了以下代码,我的问题在最后一段

'----------------------------------------------------------------------------------------
'======================================= LeftClick ======================================
'----------------------------------------------------------------------------------------
'LeftClick actions: If Mine -> Game Over, If Number -> show block, If empty -> show blocks around
'When Game Over (Show grid entirely) -> UserForm to propose to Start a new game or Quit

Public Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Grid()
Dim GridLastRow As Integer, GridLastColumn As Integer

GridLastRow = Range("B2").Value + 4
GridLastColumn = Range("B3").Value + 4

ReDim Grid(4 To GridLastRow + 1, 4 To GridLastColumn + 1)

'Execute actions only when selected cell is on the Grid
    If Target.Row > GridLastRow Or Target.Column > GridLastColumn Then Exit Sub
    If Target.Row < 5 Or Target.Column < 5 Then Exit Sub

'If Rightclick exit SelectionChange event
    If GetAsyncKeyState(2&) Then Exit Sub

'If the block is already shown then exit
    If Target.Interior.ColorIndex = -4142 Then Exit Sub

'If user selects multiple cells: Message and exit sub
    If Target.Cells.Count > 1 Then
        MsgBox "           !!! Easy Tiger !!!" & vbNewLine & "       One block at a time"
        Cells(1, 1).Select
        Exit Sub
    End If

'We show the value from the array in the selected block
    Target.Value = Grid(Target.Row, Target.Column)
    Target.Font.ColorIndex = 1
    Target.Interior.ColorIndex = -4142

    'If it is a Mine, Game Over
        If Grid(Target.Row, Target.Column) = "X" Then
            Target.Font.ColorIndex = 3
            MsgBox "GAME OVER" & vbNewLine & " :( "
            Range("D4").Resize(NbRows + 1, NbColumns + 1) = Grid
            Range("I3") = "YOU LOST"
        End If

'==This is the part I have trouble with==============================
    'If it is empty, shows surrounding blocks
        If Grid(Target.Row, Target.Column) = "" Then
            Cells(Target.Row - 1, Target.Column - 1).Select
            Cells(Target.Row - 1, Target.Column).Select
            Cells(Target.Row - 1, Target.Column + 1).Select
            Cells(Target.Row, Target.Column - 1).Select
            Cells(Target.Row, Target.Column + 1).Select
            Cells(Target.Row + 1, Target.Column - 1).Select
            Cells(Target.Row + 1, Target.Column).Select
            Cells(Target.Row + 1, Target.Column + 1).Select
        End If

    Cells(1, 1).Select

End Sub

感谢您的帮助

0 个答案:

没有答案