如何获得一个复杂数组的重新计算副本 [英] How to get a recalculated copy of a complex array

问题描述

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

  MyArray = array（15，22，array（1，array（7，3） 9）
或
 MyArray = Range（A1：B17）
或
a填满MyArray（9,20,8,3），可能包含其他未知数组
  

要获取值，我通常会使用 For Each ... 它每次在数组中找到一个数组时都调用它。但是，我无法将价值观重新放在其中。让我们试试一个简单的例子：

  Sub Test（）
 Dim a As Variant，b As Variant 
a = Array（1，2）
对于每个b在
b = b + 1 
下一个
每个b在
 Debug.Print b 
下一个
 End Sub 
  

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

 函数Test2（a As Variant）As Variant 
 Dim i As Long 
如果IsArray（a）Then 
对于i = LBound（a）到UBound（a）
a（i）= Test2（a（i））
下一个
 Test2 = a 
 Else 
 Test2 = a + 1 
 End If 
 End Function 
 
 Sub Test3（）
 Dim a As Variant 
a = Array（1，Array（2，3））
 Debug.PrintArray（& a（0）&，Array（& a（1）（0）& ，& a（1）（1）&））
a = Test2（a）
 Debug.PrintArray（& a（0）& & a（1）（0）&，& a（1）（1）&））
 End Sub 
  

虽然这适用于1-D数组，但它不适用于nD数组。而我仍然不知道我的数组将如何。

有未知数组的解决方法还是将值放在$ code之内的方法> For Each ... -loop？将 MyArray（1，1）转换为 Array（Array（，），Array）





（，））开始时看起来不错，但由于事实 Array（Array（，），Array（，））仍然是一个有效的数组开始。同样由于可能的复杂性，记住如何再次放在一起是不可能的。至少不会有任何收藏或自我声明的类型。

编辑：

关于实际答案可能不完全清楚我想要的。

  Dim MyArray（5，5）as Variant 
 MyArray 0，0）= 7 
 MyArray（0，1）= 9 
 ... 
 MyArray（4，0）= 7 
 ... 
  

这是一个简单的2-D数组，我的 Test2 不能使用 MyArray（i）处理它。这将导致错误。所以每个回答都像我的函数一样都是不正确的。

解决方案

b


  Sub Test（）
 Dim a 
a = Array（1，Array（2，Array（4，5，6））） 
处理a 
 PrintIt a 
 End Sub 
子进程（a）
对于i = 0对于UBound（a）
如果不是IsArray（a（ i））然后
a（i）= a（i）+ 1 
 Else 
处理a（i）
结束如果
下一个
 End Sub 
 Sub PrintIt（a）
对于i = 0 To UBound（a）
如果不是IsArray（a（i））然后
 Debug.Print a（i）
 Else 
 PrintIt a（i）
 End If 
下一个
 End Sub 
  

。

更新

所以我看到你工作，所以我会贡献更多。我的目标是帮助你和读者阅读。

正如我在第一条评论中提到的那样... 测试数组的排名需要错误处理或SAFEARRAY描述符查询。

所以我会给你两种方法。你制定了一种方法来做前者，但是为了在上面的答案的基础上，这里是我将如何使用VBA：

  Sub Test（）
 Dim a，b 
b = [{11,12; 13,14}] 
a = Array（1，Array（2，Array（4， b））
迭代a 
迭代a，1 
 End Sub 
子进程（a）
a = a + 1 
 End Sub 
 sub Iterate（a，可选bReport As Boolean = False）
 Dim rank& i& j& z 
如果IsArray（a）Then 
选择案例ArrayRank（a）
案例1 
对于i = LBound（a）到UBound（a）
迭代a（i），bReport 
下一个
案例2 
对于i = LBound （a）UBound（a）
对于j = LBound（a，2）到UBound（a，2）
迭代a（i，j），bReport 
下一个
 Next 
 End选择
 Else 
如果bReport然后
 Debug.Print a 
 Else 
处理a 
如果
结束If 
 End Sub 
函数ArrayRank&（a）
 Dim j& ，k& 
 On Error Resume Next 
对于j = 1至60 
k = LBound（a，j）
如果Err Then ArrayRank = j  -  1：退出
下一个
结束功能
  

是的，只使用VBA，你必须要使用硬编码开关，例如Select Case，因为实现了VBA数组element\rank索引的方式。我上面的更新答案显示了如何使用前两个维度。那么当然需要更高级的额外的案例。

然而（再次就像我前面说过的），另一种方式是询问SAFEARRAY描述符。这是一个通用的解决方案，但需要更深入地了解COM变量的内部。我已经表明它与排名1，2和3一起工作。但它应该适用于所有排名：

 私有声明子GetMem2 Libmsvbvm60（ByVal Addr As Long，RetVal As Integer）
私有声明Sub GetMem4 Libmsvbvm60（ByVal Addr As Long，RetVal As Long）
 
私有声明Sub CopyMemory Lib kernel32.dll别名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到1，1到1，1到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）））
迭代a 
 Debug.Print 
迭代a，1 
 End Sub 
子进程（a）
a = a + 1 
 End Sub 
 Sub Iterate（a，可选bReport As Boolean = False）
 Dim t％，dims％，elems& bounds&（），ptr& ptrBase& ptrData& 
 Dim rank& c& i& z 
如果IsArray（a）Then 
 ptr = VarPtr（a）
 GetMem2 ptr，t 
 If（t和16384）= 16384 Then'ByRef Variant Array（16384 = VT_BYREF）
 GetMem4 ptr + 8，ptr 
 GetMem4 ptr，ptrBase 
 Else 
 GetMem4 ptr + 8，ptrBase 
结束如果
 GetMem4 ptrBase + 12，ptrData 
 GetMem2 ptrBase，dims 
c = UBound（a） -  LBound（a）+ 1 
对于i = 2要变暗
c = c *（UBound（a，i） -  LBound（a，i）+ 1）
下一个
对于i = 0 To c  -  1 
 CopyMemory ByVal VarPtr（z） ByVal ptrData + i * 16，16& 
迭代z，bReport 
 CopyMemory ByVal ptrData + i * 16，ByVal VarPtr（z），16& 
 CopyMemory ByVal VarPtr（z），0& 16& 
下一个
 Else 
如果bReport然后
 Debug.Print a 
 Else 
处理
结束如果
结束如果
 End Sub 
  

注意：为32位Excel声明API。如果您希望支持64位，则需要进行编辑。

I need to calculate an unknown complex array and get a perfect recalculated copy of it while I don't know how the array looks. For example:

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

To get the values, I'd normally loop with For Each ... which calls itself every time it finds an array inside the array. However I'm unable to put the values back in it. Let's try an easy example:

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

While that's easy enough to solve it better, it still shows my problem. Having just a copy won't let me put the new value back in it. Assuming only 1-D arrays and values:

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

While this works for 1-D arrays, it won't do for n-D arrays. And still I don't know how my array will be.

Is there a workaround for unknown arrays or a way to put back values inside of a For Each ...-loop?

Converting MyArray(1, 1) to Array(Array(,),Array(,)) looked nice at the beginning, but converting it back is kinda impossible due to the fact Array(Array(,),Array(,)) is still a valid array to start with. Also due to possible complexity it would be as good as impossible to "remember" how it has to be put together again. At least there won't be any collection's or self-declared-types.

Edit:
Regarding the actual answers it may not be completely clear what I want.

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

This is a simple 2-D Array and my Test2 can't handle it with a MyArray(i). It will lead to an error. So each answer doing the same like my function can't be correct.

解决方案

Consider this:

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

So I see that you worked on it and so I'll contribute more. My aim here is to help you and anyone reading this learn.

As I mentioned in my first comment... Testing for rank of an array requires error handling or SAFEARRAY descriptor interrogation.

So I'll give you both ways. You worked out one way to do the former, but to build on my answer above, here is how I would do it using VBA only:

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

And yes, using VBA only you will by necessity be required to use a hard coded switch, such as a Select Case, because of the way VBA array element\rank indexing is implemented. My updated answer above shows how to work with the first two dimensions. It would of course need additional Cases for higher ranks.

However (and again just like I said upfront) the other way is to interrogate the SAFEARRAY descriptor. This makes for a general solution, but requires a much deeper understanding of the internals of COM variables. I've shown it working with ranks 1, 2, and 3. But it should work with all ranks:

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

Note: APIs are declared for 32-bit Excel. You'll need to edit that if you wish to support 64-bit as well.

这篇关于如何获得一个复杂数组的重新计算副本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！