游戏代码大全可复制免费(游戏代码修改器)

做什么?

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代码如下:


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
    
本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容, 请发送邮件至 cloud@ksuyun.com 举报,一经查实,本站将立刻删除。
如若转载,请注明出处:https://www.daxuejiayuan.com/44927.html