如何获得复杂数组的重新计算副本

我需要计算一个未知的复杂数组，并得到一个完美的重新计算副本，而我不知道数组的外观。 例如：

MyArray = array(15, 22, array(1, array(7, 3), 9)) or MyArray = Range("A1:B17") or a filled up MyArray(9, 20, 8, 3) which may contain other unknown arrays 

为了得到这些值，我通常会使用For Each ...来循环，每当它在数组中find一个数组时，就会调用它自己。 不过，我无法将这些数值放回去。 让我们试试一个简单的例子：

 Sub Test() Dim a As Variant, b As Variant a = Array(1, 2) For Each b In a b = b + 1 Next For Each b In a Debug.Print b Next End Sub 

虽然这很容易解决它，但它仍然显示我的问题。 只有副本不会让我把新的价值放回去。 假设只有一维数组和值：

 Function Test2(a As Variant) As Variant Dim i As Long If IsArray(a) Then For i = LBound(a) To UBound(a) a(i) = Test2(a(i)) Next Test2 = a Else Test2 = a + 1 End If End Function Sub Test3() Dim a As Variant a = Array(1, Array(2, 3)) Debug.Print "Array(" & a(0) & ", Array(" & a(1)(0) & "," & a(1)(1) & "))" a = Test2(a) Debug.Print "Array(" & a(0) & ", Array(" & a(1)(0) & "," & a(1)(1) & "))" End Sub 

虽然这适用于一维数组，但不适用于nD数组。 而我仍然不知道我的arrays将如何。

是否有未知数组的解决方法或将值放回For Each ... -loop的方法？

Array(Array(,),Array(,))转换为Array(Array(,),Array(,)) ，但是将其转换回来是不可能的。仍然是一个有效的数组开始。 另外，由于可能的复杂性，它将不可能“记住”它是如何再次组合在一起的。 至less不会有任何集合或自我声明types。

编辑：
关于实际的答案，可能并不完全清楚我想要什么。

 Dim MyArray(5, 5) as Variant MyArray(0, 0) = 7 MyArray(0, 1) = 9 ... MyArray(4, 0) = 7 ... 

这是一个简单的二维数组，我的Test2无法用MyArray(i)处理它。 这将导致错误。 所以每个像我的function一样的答案是不正确的。

Answer 1

考虑一下：

 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.

所以我会给你两种方式。 你已经find了一种方法去做前者，但是为了build立在上面的答案上，下面是我将如何使用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，您将必须使用硬编码开关，例如Select Case，因为VBA数组元素\ rank索引被实现。 上面我更新的答案显示了如何使用前两个维度。 当然，还需要更多的情况下，更高的级别。

然而（就像我之前说过的那样）另一种方法是询问SAFEARRAY描述符。 这是一个通用的解决scheme，但需要更深入地了解COMvariables的内部。 我已经展示了它与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位，则需要进行编辑。

Answer 2

该解决scheme探索了处理multidimensional array和matrix数组的方法

matrix数组（范围数组）：假设我们想将范围B7:D12乘以15，并将结果放在H7:J12

使用这些程序（见图1中的结果） ：

 Sub Ary_Process_Matrix() Dim rTrg As Range Dim aOriginal As Variant, aResult As Variant Set rTrg = ThisWorkbook.Sheets(1).Range("B7:D12") With rTrg aOriginal = .Cells aResult = Ary_Processor_Matrix(aOriginal) .Offset(0, 3 + .Columns.Count).Value = aResult End With End Sub Function Ary_Processor_Matrix(aInput As Variant) As Variant Dim aOutput As Variant Dim lR As Long, lC As Long Rem Set Output Array structure by copying it from Input Array aOutput = aInput Rem Process Input Array and Place Results in Output Array For lR = LBound(aInput, 1) To UBound(aInput, 1) For lC = LBound(aInput, 2) To UBound(aInput, 2) aOutput(lR, lC) = aInput(lR, lC) * 15 Next: Next Rem Set Results Ary_Processor_Matrix = aOutput End Function 

图。1

multidimensional array：

假设你有这个“原始” Array ：

 aOriginal = Array( _ Array(1, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, 5, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, 5, 7, Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, 5, 7, 11)) 

你想把它的每个成员乘以15

使用此函数来处理“原始” Array并获取结果 Array

 Function Ary_Processor(aInput As Variant) As Variant Dim aOutput As Variant Dim l As Long Rem Set Output Array structure by copying it from Input Array aOutput = aInput Rem Process Input Array and Place Results in Output Array For l = LBound(aInput) To UBound(aInput) If IsArray(aInput(l)) Then aOutput(l) = Ary_Processor(aInput(l)) Else aOutput(l) = aInput(l) * 15 End If: Next Rem Set Results Ary_Processor = aOutput End Function 

此过程并行地打印两个数组来validation结果

 Sub Ary_Print_Arrays(aAry1 As Variant, aAry2 As Variant) Dim l As Long Debug.Print "Lvl"; Tab(11); "Array 1"; Tab(21); "Array 2" For l = LBound(aAry1) To UBound(aAry1) If IsArray(aAry1(l)) Then Call Ary_Print_Arrays(aAry1(l), aAry2(l)) Else Debug.Print l; Tab(11); aAry1(l); Tab(21); aAry2(l) End If: Next End Sub 

处理“原始”并打印“结果”

 Sub Ary_Process() Dim aOriginal As Variant, aResult As Variant Dim l As Long aOriginal = Array( _ Array(1, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, 5, Array(1, 2, 3, 5, 7, 11), Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, 5, 7, Array(1, 2, 3, 5, 7, 11)), _ Array(1, 2, 3, 5, 7, 11)) aResult = Ary_Processor(aOriginal) Debug.Print vbLf; "Print Arrays 3D" Call Ary_Print_Arrays(aOriginal, aResult) End Sub 

这是多维的“aOriginal”数组

这是多维的“aResult”数组

结果也可以在即时窗口中看到