Excel 用vba 制作2048单机游戏 附部分代码

vba 不仅可以给工作带来便捷，提高工作效率（之前做了个Excel合并、拆分分割的工具），还能做单机小游戏。

网上看了下，可以做好多单机游戏。

通过网上看了下大致的算法逻辑，自己尝试写了个。

主要是理解算法逻辑就好写了：前（后）移动，合并（包括相加）。

1.过程或函数 中可选参数及默认值的写法，optional isBF as Boolean = true。

2.数组的重新定义，redim preserve。

3.过程中怎么设置类似函数返回值。可以利用数组的地址引用byRef来获取返回值。

4.随机数的生成，Randomize，rnd()。

5.进一步熟悉数组使用。二维数组拆分一维数组，worksheetFunction.index()。

6.按键监控触发事件，Application.OnKey"{up}", "过程名" 向上键。

……

……

1.就是按键监控触发事件，Application.OnKey"{up}", "过程名" ，过程是否可以带参数呢？

2.算法逻辑是否可以优化。

Sub 数字前后移动(ByRef arr(), Optional isBF As Boolean = True) Dim i%, l%, u%, j% Dim inx(1 To 4) l = LBound(arr) u = UBound(arr) If isBF Then For i = l To u If arr(i) <> "" And arr(i) > 0 Then j = j 1 inx(j) = arr(i) End If Next i Else j = u For i = u To l Step -1 If arr(i) <> "" And arr(i) > 0 Then inx(j) = arr(i) j = j - 1 End If Next i End If For i = 1 To 4 arr(i) = inx(i) Next i End Sub

'isBF b表示back后开始相加 f表示前相加forward,默认true 为前 Sub 合并相加(ByRef inx(), Optional isBF As Boolean = True) Dim i% If isBF Then For i = 1 To UBound(inx) - 1 'Debug.Print inx(i) If inx(i) = "" Or inx(i) = 0 Then GoTo A End If If inx(i) = inx(i 1) Then inx(i) = inx(i) * 2 inx(i 1) = "" End If A: Next i Else For i = UBound(inx) To LBound(inx) 1 Step -1 If inx(i) = "" Or inx(i) = 0 Then GoTo B End If If inx(i) = inx(i - 1) Then inx(i) = inx(i) * 2 inx(i - 1) = "" End If B: Next i End If End Sub

''向下移动 Sub moveDown() Dim sht As Worksheet Dim i%, j%, temp Dim arr(), brr() Set sht = ThisWorkbook.Sheets(2) arr = sht.Range("a1:d4") ReDim crr(1 To UBound(arr)) arr = Application.WorksheetFunction.Transpose(arr) For i = 1 To 4 crr = Application.WorksheetFunction.Index(arr, i) Call 数字往前移动(crr, False) Call 合并相加(crr, 0) Call 数字往前移动(crr, 0) ReDim Preserve brr(1 To i) brr(i) = crr Next i brr = Application.WorksheetFunction.Transpose(brr) sht.Range("a1:d4") = brr Erase crr Erase brr Erase crr End Sub