考虑一下:
Sub Test()
Dim a
a = Array(1, Array(2, Array(4, 5, 6)))
Process a
PrintIt a
End Sub
Sub Process(a)
For i = 0 To UBound(a)
If Not IsArray(a(i)) Then
a(i) = a(i) + 1
Else
Process a(i)
End If
Next
End Sub
Sub PrintIt(a)
For i = 0 To UBound(a)
If Not IsArray(a(i)) Then
Debug.Print a(i)
Else
PrintIt a(i)
End If
Next
End Sub
.
UPDATE
所以我看到你为此付出了努力,所以我会做出更多贡献。我的目标是帮助您和任何阅读本文的人学习。
正如我在第一条评论中提到的......Testing for rank of an array requires error handling or SAFEARRAY descriptor interrogation.
所以我给你两种方法。您找到了一种方法来实现前者,但为了以我上面的答案为基础,以下是我仅使用 VBA 来实现的方法:
Sub Test()
Dim a, b
b = [{11,12;13,14}]
a = Array(1, Array(2, Array(4, 5, b)))
Iterate a
Iterate a, 1
End Sub
Sub Process(a)
a = a + 1
End Sub
Sub Iterate(a, Optional bReport As Boolean = False)
Dim rank&, i&, j&, z
If IsArray(a) Then
Select Case ArrayRank(a)
Case 1
For i = LBound(a) To UBound(a)
Iterate a(i), bReport
Next
Case 2
For i = LBound(a) To UBound(a)
For j = LBound(a, 2) To UBound(a, 2)
Iterate a(i, j), bReport
Next
Next
End Select
Else
If bReport Then
Debug.Print a
Else
Process a
End If
End If
End Sub
Function ArrayRank&(a)
Dim j&, k&
On Error Resume Next
For j = 1 To 60
k = LBound(a, j)
If Err Then ArrayRank = j - 1: Exit For
Next
End Function
是的,仅使用 VBA,由于 VBA 数组元素\等级索引的实现方式,您必然需要使用硬编码开关,例如 Select Case。我上面更新的答案展示了如何使用前两个维度。当然,更高的等级需要额外的箱子。
然而(就像我前面所说的那样)另一种方法是询问 SAFEARRAY 描述符。这提供了一个通用的解决方案,但需要对 COM 变量的内部结构有更深入的了解。我已经展示了它适用于等级 1、2 和 3。但它应该适用于所有等级:
Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Integer)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Sub Test()
Dim a, b, c
b = [{110,120;130,140}]
ReDim c(1 To 1, 1 To 1, 1 To 3)
c(1, 1, 1) = 500
c(1, 1, 2) = 600
c(1, 1, 3) = 700
a = Array(1, Array(2, Array(40, 50, b, c)))
Iterate a
Debug.Print
Iterate a, 1
End Sub
Sub Process(a)
a = a + 1
End Sub
Sub Iterate(a, Optional bReport As Boolean = False)
Dim t%, dims%, elems&, bounds&(), ptr&, ptrBase&, ptrData&
Dim rank&, c&, i&, z
If IsArray(a) Then
ptr = VarPtr(a)
GetMem2 ptr, t
If (t And 16384) = 16384 Then 'ByRef Variant Array (16384 = VT_BYREF)
GetMem4 ptr + 8, ptr
GetMem4 ptr, ptrBase
Else
GetMem4 ptr + 8, ptrBase
End If
GetMem4 ptrBase + 12, ptrData
GetMem2 ptrBase, dims
c = UBound(a) - LBound(a) + 1
For i = 2 To dims
c = c * (UBound(a, i) - LBound(a, i) + 1)
Next
For i = 0 To c - 1
CopyMemory ByVal VarPtr(z), ByVal ptrData + i * 16, 16&
Iterate z, bReport
CopyMemory ByVal ptrData + i * 16, ByVal VarPtr(z), 16&
CopyMemory ByVal VarPtr(z), 0&, 16&
Next
Else
If bReport Then
Debug.Print a
Else
Process a
End If
End If
End Sub
注意:API 是针对 32 位 Excel 声明的。如果您也希望支持 64 位,则需要对其进行编辑。