VBA中的赛道？_编程黑洞网

因此，我看了八月挑战赛：

投票最多的答案是
Racetrack1：
“在
Racetrack2游戏中，汽车比赛
围绕由在
方格上绘制的两个同心闭环所包围的轨道。实现一个玩这个游戏的程序。“

1在meta2中回答的链接游戏

，我想，“嘿，自我，你应该尝试一下”-但是鉴于我只真正了解VBA，所以我在excel中做到了。也许这不是挑战的意图，但无论如何我还是做到了。

在github上体验它。

请注意，您必须已安装MS excel并启用了宏。我无法在OSX上运行它。

该游戏供两名人类玩家使用表单界面在板上移动他们的汽车。

您可以通过点击触发大多数代码运行的重置按钮来开始游戏-您还可以通过激活以下表格来恢复游戏

Sub Button1_Click()
    MsgBox ("This will create a new gameboard")
    Application.ScreenUpdating = False
    Range("A1:Z24").ClearContents
    Range("A1:Z24").ClearFormats
    CreateGrid
    FillOuterGrid
    FillInnerCircle
    StoreSpeed
    Application.ScreenUpdating = True
    Instruct.Show
    GameControl.Show
End Sub

是创建赛道，每场比赛都是半随机-

Option Explicit
Sub CreateGrid()
    'Store background color in a variable so that adjusting only takes one edit
    Const BACKGROUND_COLOR As Long = vbBlack
    'In the properties of my worksheet, I gave the WS object an inherent name (like Sheet8), but called it GameBoardSheet
    With GameBoardSheet
        .Name = "GameBoard"
        Columns("B:Y").ColumnWidth = 2.14
        Columns("A").ColumnWidth = 50
        Columns("Z").ColumnWidth = 50
        Rows(1).RowHeight = 100
        Rows(24).RowHeight = 100
        Range("A1:Z1").Merge
        Range("A1").Interior.Color = BACKGROUND_COLOR
        Range("A24:Z24").Merge
        Range("A24").Interior.Color = BACKGROUND_COLOR
        Range("A2:A23").Merge
        Range("A2").Interior.Color = BACKGROUND_COLOR
        Range("Z2:Z23").Merge
        Range("z2").Interior.Color = BACKGROUND_COLOR
        Range("B2").Select
    End With
End Sub

Sub FillOuterGrid()
Dim i As Integer
Dim rngCell As Range
    For Each rngCell In Range("B2:Y2")
      i = Application.WorksheetFunction.RandBetween(0, 2)
      rngCell.Offset(i, 0).Interior.ColorIndex = 15
    Next
    For Each rngCell In Range("b23:Y23")
        i = Application.WorksheetFunction.RandBetween(-2, 0)
        rngCell.Offset(i, 0).Interior.ColorIndex = 15
    Next
    For Each rngCell In Range("B5:B20")
        i = Application.WorksheetFunction.RandBetween(0, 2)
        rngCell.Offset(0, i).Interior.ColorIndex = 15
    Next
    For Each rngCell In Range("Y5:Y20")
        i = Application.WorksheetFunction.RandBetween(-2, 0)
        rngCell.Offset(0, i).Interior.ColorIndex = 15
    Next

    For Each rngCell In Range("B4:Y4")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(-1).Interior.ColorIndex = 15
            rngCell.Offset(-2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("B3:Y3")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(-1).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("B21:Y21")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(1).Interior.ColorIndex = 15
            rngCell.Offset(2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("B22:Y22")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(1).Interior.ColorIndex = 15
        End If
    Next

    For Each rngCell In Range("D2:D23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, -1).Interior.ColorIndex = 15
            rngCell.Offset(, -2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("C2:C23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, -1).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("W2:W23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, 1).Interior.ColorIndex = 15
            rngCell.Offset(, 2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("X2:X23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, 1).Interior.ColorIndex = 15
        End If
    Next
End Sub

Sub FillInnerCircle()
Dim rngCell As Range
Dim i As Integer
Range("J11:P14").Interior.ColorIndex = 15
For Each rngCell In Range("J9:P9")
    i = Application.WorksheetFunction.RandBetween(0, 1)
    rngCell.Offset(i).Interior.ColorIndex = 15
Next
For Each rngCell In Range("J16:P16")
    i = Application.WorksheetFunction.RandBetween(-1, 0)
    rngCell.Offset(i).Interior.ColorIndex = 15
Next

For Each rngCell In Range("H11:H14")
    i = Application.WorksheetFunction.RandBetween(0, 1)
    rngCell.Offset(, i).Interior.ColorIndex = 15
Next
For Each rngCell In Range("R11:R14")
    i = Application.WorksheetFunction.RandBetween(-1, 0)
    rngCell.Offset(, i).Interior.ColorIndex = 15
Next

'fill
For Each rngCell In Range("J9:P9")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(1).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("J16:P16")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(-1).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("H11:H14")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(, 1).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("R11:R14")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(, -1).Interior.ColorIndex = 15
    End If
Next
'start and end
With Range("M17:M20").Interior
        .Pattern = xlUp
        .PatternColorIndex = xlAutomatic
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
Range("N19").Interior.ColorIndex = 3
Range("N19") = "P2"
Range("N20").Interior.ColorIndex = 8
Range("N20") = "P1"
End Sub

我将向量和位置存储在单元格中我真的不知道要执行此操作的全局变量。6。

 Sub StoreSpeed()
'I'm storing speed and position in cells on the sheet as I don't have a global variable for them
Range("A100") = 0
Range("A101") = 0
Range("A102") = 20
Range("A103") = 14
Range("A200") = 0
Range("A201") = 0
Range("A202") = 19
Range("A203") = 14
End Sub

接下来，您将看到说明

关闭指令后，将打开表格，即您如何玩-

表格显示了当前的方向速度和显示标签的播放器。玩家可以使用两个组合框在左右方向上选择（-1,0,1）（负向右/向上或向左/向下变慢）。选择后，玩家按下GO按钮。

现在，该表格将重置并显示下一位玩家的状态，轮到他们了。

如果碰到墙壁或其他汽车，则会触发损失情况

仅当您到达终点线时才会触发胜利。

以下是表格及其代码-

Private Sub UserForm_Initialize()
    'Placement of Form - works well on some machines, not perfect on others
    Me.StartUpPosition = 0
    Me.Top = Application.Top + 25
    Me.Left = Application.Left + 30

    'Populate the combobox lists with an array upon initialization - this way they will always retain the values I set here
    cmbVx.List = Array("-1", "0", "1")
    cmbVy.List = Array("-1", "0", "1")

    'Player1 goes first
    LabelP1.Visible = True
    LabelP2.Visible = False
    CurrentRow.Text = Range("A102").Value
    CurrentCol.Text = Range("A103").Value
    CurrentX.Text = Range("A100").Value
    CurrentY.Text = Range("A101").Value
End Sub

这是单击GO按钮时控制玩家的代码，这是控制游戏性的方法-

Private Sub btnGo_Click()
On Error GoTo errHandler
Dim Vx As Integer
Vx = cmbVx.Value
Dim Vy As Integer
Vy = cmbVy.Value

Dim x As Integer
Dim y As Integer
Dim intCase As Integer
Dim MoveMe As Range

If LabelP1.Visible = True Then
    intCase = 1
    Else: intCase = 2
End If

Select Case intCase
    Case 1
    'Speed
    x = GameBoardSheet.Range("A100") + Vx
    y = GameBoardSheet.Range("A101") + Vy
    GameBoardSheet.Range("A100") = x
    GameBoardSheet.Range("A101") = y

    'Move
    With Cells(Int(CurrentRow.Value), Int(CurrentCol.Value))
        .ClearContents
        .Interior.ColorIndex = xlNone
        'Excel uses (rows,cols) notation, so Y direction is first
        'We're using (-y) so that positive 1 moves upward
        Set MoveMe = .Offset(-y, x)
    End With

            If MoveMe.Interior.ColorIndex = xlNone Then
                MoveMe = "P1"
                MoveMe.Interior.ColorIndex = 8
                Range("A102") = MoveMe.Row
                Range("A103") = MoveMe.Column
            Else: GoTo WinLose
            End If

    'set up form for next player
    LabelP1.Visible = False
    LabelP2.Visible = True
    CurrentX.Text = Range("A200")
    CurrentY.Text = Range("A201")
    CurrentRow.Text = Range("A202")
    CurrentCol.Text = Range("A203")
    Exit Sub

    'Player 2 turn
    Case 2
    'Speed
    x = GameBoardSheet.Range("A200") + Vx
    y = GameBoardSheet.Range("A201") + Vy
    GameBoardSheet.Range("A200") = x
    GameBoardSheet.Range("A201") = y

    'Move
    With Cells(Int(CurrentRow.Value), Int(CurrentCol.Value))
        .ClearContents
        .Interior.ColorIndex = xlNone
        Set MoveMe = .Offset(-y, x)
    End With

            If MoveMe.Interior.ColorIndex = xlNone Then
                MoveMe = "P2"
                MoveMe.Interior.ColorIndex = 3
                Range("A202") = MoveMe.Row
                Range("A203") = MoveMe.Column
            Else: GoTo WinLose
            End If

    'set up form for next player
    LabelP2.Visible = False
    LabelP1.Visible = True
    CurrentX.Text = Range("A100")
    CurrentY.Text = Range("A101")
    CurrentRow.Text = Range("A102")
    CurrentCol.Text = Range("A103")
    Exit Sub
    End Select

'TODO: Create function
WinLose:
    If MoveMe.Interior.ColorIndex = xlAutomatic Then
        MsgBox ("You Win!")
        MoveMe = "P1"
        MoveMe.Interior.ColorIndex = 6
    Else: MsgBox ("Whoops, you crashed!")
    End If
    Unload GameControl
    Exit Sub
'TODO: Create Function
errHandler:
    MsgBox ("Please select your values")
End Sub

总体来说，它可以工作。我认为可以进行一些与游戏性相关的改进-

要赢得比赛，您必须站在终点线上，而不仅仅是越过终点。因此，您不会触发获胜条件，实际上，如果您在穿越后撞墙，可能会引发损失。我能想到的唯一一件事就是检查玩家是否从棋盘的左下象限开始，然后将其发送给函数以确定他们是否获胜，否则将其发送回去。这似乎不是最理想的。
只要您进入有效空间，就可以在墙上“跳跃”
您可以在开始时就作弊并顺时针旋转（但我是说，您在优秀）
以足够的速度，您可以跳出游戏板并在各处运行。我可以检查行/列是否不超过（y，x），但这似乎草率。
我敢肯定，如果您尝试着陆不存在的单元格（例如，行），它将出错或列<0）

我无法弄清楚如何获取将在表格中保留的Global或Public变量，因此速度和位置信息存储在单元格A100：A103和A200：A203中。如Matt的杯子所述，这也许是一件好事。

你怎么玩？

它可以在excel中加载-它不是独立的

我很难让表格显示出来。我知道了。

我没有运行此程序的可能性，并且我对Excel / VBA的内容不熟悉，因此我很难说出来。该程序是玩游戏还是允许用户玩游戏？

我很期待玩/评论。

#1 楼

隐式工作表引用

Sub CreateGrid()
    ActiveSheet.Name = "GameBoard"
    Columns("B:Y").ColumnWidth = 2.14
    Columns("A").ColumnWidth = 50
    Columns("Z").ColumnWidth = 50
    Rows(1).RowHeight = 100
    Rows(24).RowHeight = 100
    Range("A1:Z1").Merge
    Range("A1").Interior.Color = vbBlack
    Range("A24:Z24").Merge
    Range("A24").Interior.Color = vbBlack
    Range("A2:A23").Merge
    Range("A2").Interior.Color = vbBlack
    Range("Z2:Z23").Merge
    Range("z2").Interior.Color = vbBlack
    Range("B2").Select
End Sub

虽然此过程中仅第一行提到ActiveSheet，但此过程中的每一行都隐式引用Application.ActiveSheet...。提示：对活动工作表的引用总是或多或少地不稳定。

提示：通过在创建网格时关闭Application.ScreenUpdating，可以消除“闪烁”，并更快地生成网格：用户甚至不会眨眼。

CodeName
一种更好的方法是为该工作表赋予有意义的程序名称。从屏幕截图中，我可以告诉您将其保留为默认值Sheet8； Sheet.CodeName的值是一个“免费”标识符参考-VBA使用它创建一个标识符，您可以在代码中使用该标识符。
我将其重命名为GameBoardSheet并可能使用了With块。
另外，有时您可能想要使用vbBlack以外的另一种背景色，并且发生这种情况时，您只需要进行一次更改：

Private Sub CreateGrid()
    Const BACKGROUND_COLOR As Long = vbBlack
    With GameBoardSheet
        .Name = "GameBoard"
        .Columns("B:Y").ColumnWidth = 2.14
        .Columns("A").ColumnWidth = 50
        .Columns("Z").ColumnWidth = 50
        .Rows(1).RowHeight = 100
        .Rows(24).RowHeight = 100
        .Range("A1:Z1").Merge
        .Range("A1").Interior.Color = BACKGROUND_COLOR
        '...
    End With
End Sub

GameBoardSheet的一个不错的命名是，您可以现在消除所有这些：

Sheets("GameBoard")

，只需引用该“免费” GameBoardSheet参考即可。

会花费多少精力？重构代码并将UI重新实现为ActiveX控件面板而不是表单？在我看来，这将使UI更加“自然”：

应用程序逻辑不应依赖于表单（更不用说完全在表单后面实现了），应该将其封装在自己的类模块。
尝试手工制作刷过的UI；冻结游戏屏幕右下角外面的窗格，并保护工作表，以便用户能做的就是与按钮交互：绿色的大“ Go！”按钮。按钮和4个箭头按钮，分别在每个方向的红色/关闭和蓝色/打开之间切换。对于用户而言，这是对-1 / 0 / + 1方向速度的一个很好的抽象：

如果[左]和[右]都是相同的颜色，则X速度为0
如果[上]和[下]都是相同的颜色，则Y速度为0
如果[左]为蓝色而[右]为红色，X速度为1
如果[右]为蓝色且[左]为红色，X速度为-1
如果[上]为蓝色且[向下] ]为红色，Y速度为1
如果[向下]为蓝色，[向上]为红色，则Y速度为-1
如果用户不进行任何切换，则使用上一转弯的值

我可以使用一些ITrack方法创建一个Draw接口：

Public Sub Draw()
End Sub

然后我可以拥有一个EasyTrack，一个MediumTrack和一个HardTrack，并将FillOuterGrid和FillInnerCircle移到私有状态例如EasyTrack类的方法； Draw将调用这两个方法。然后，MediumTrack和HardTrack将绘制不同的图案。
将矢量保存在电子表格本身中。你知道吗？这个棒极了。您保存工作簿，并且您还保存了游戏！使用全局变量，不仅，您会拥有[抓紧鼻子]全局变量...您的游戏状态将随着程序的执行而生死攸关，因此，您必须找出一种将向量持久化的方法无论如何，如果您想在退出前保存游戏状态。

\ $ \ begingroup \ $
我了解其中的大部分内容，我将不得不对使用activeX进行一些研究，但是谢谢！
\ $ \ endgroup \ $
–雷斯塔法里安
15年8月14日在11:10

\ $ \ begingroup \ $
我给这个复选标记作为最高答案-但是所有三个答案都极大地帮助了！
\ $ \ endgroup \ $
–雷斯塔法里安
16年1月27日在14:46

#2 楼

我有一些可以改进的地方：

正如我发现的那样，除了系统功能/方法之外，不应使用c，因此请避免命名。

For Each c In Range("B2:Y2")

代替cells，您可以简单地使用以下代码而不是重新分配值： br />

var = var + otherVar缩进得太远了，只间隔了一个空格

Set MoveMe：不要是恐龙，不要是侏罗纪世界的克里斯·普拉特，而吵架那些恐龙（改用函数）

x = Sheets("GameBoard").Range("A100")
y = Sheets("Gameboard").Range("A101")
x = x + Vx
y = y + Vy

关于以下几点this：

Else: GoTo WinLose和Current始终遵循标准。

cur，请不要为了可读性而牺牲一些字符：cur是坏。 cur / Current更好。

current：与上述相同。

x = Sheets("GameBoard").Range("A100") + Vx
y = Sheets("Gameboard").Range("A101") + Vy

在这里也使用一个功能。

#3 楼

你有一个魔术数字退休金。

   Columns("A").ColumnWidth = 50
   Columns("Z").ColumnWidth = 50
   Rows(1).RowHeight = 100
   Rows(24).RowHeight = 100

这些虽然不太神奇，但它们是重复的。如果您决定更改边框大小，那么只在一个地方更改边框大小就不会很好吗？为此创建一个常量。但是，这几乎没有问题。

For Each rngCell In Range("B21:Y21")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(1).Interior.ColorIndex = 15
        rngCell.Offset(2).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("B22:Y22")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(1).Interior.ColorIndex = 15

ColorIndex = 15遍历此代码。虽然行/列的宽度很容易理解，但事实并非如此。不知道它是什么颜色，我不知道它是什么颜色。这绝对需要一个命名良好的常量值，但是无论您做什么，都不要像15这样命名。如果这样做，则更改值必须重命名。像这样去吧。

Const TRACK_COLOR As Integer = 15 ' gray

虽然有趣。颜色常数取决于您所运行的Office版本。 Office 2003中的呈现可能与新版本中的呈现不同。实际上，gray甚至在2007年之前都不可用。为了与早期版本兼容，最好使用RBG值。

已经有人提到过，但我想提一提再次挑战您，为您的游戏创建一些类。

创建一个DAL（数据抽象层），该DAL将单元格和范围映射到更抽象的概念。在这种情况下，一个ColorIndex类将有助于集中所有对GameBoard的调用。
创建一个.Range("A100")类，您的用户表单将调用该类，而不是将该代码全部填充在后面的代码中。如前所述，如果您愿意的话，以后换出UI层将变得更加容易。