excel - 如何获取复杂数组的重新计算副本

Question

我需要计算一个未知的复杂数组并获得它的完美重新计算副本，但我不知道该数组的外观。为了示例:

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 ... 循环，每次在数组中找到数组时都会调用自身。但是我无法将这些值放回其中。让我们尝试一个简单的例子:

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

虽然这适用于一维数组，但不适用于 n 维数组。但我仍然不知道我的数组会是什么样子。

是否有针对未知数组的解决方法或将值放回 For Each ... 循环内的方法？

将 MyArray(1, 1) 转换为 Array(Array(,),Array(,)) 一开始看起来不错，但转换回来有点不可能因为 Array(Array(,),Array(,)) 仍然是一个有效的数组。此外，由于可能的复杂性，“记住”如何再次将其组合在一起几乎是不可能的。至少不会有任何集合或 self 声明的类型。

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

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

这是一个简单的二维数组，我的 Test2 无法使用 MyArray(i) 处理它。这会导致错误。因此，每个与我的功能相同的答案都是不正确的。

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

.

更新

所以我看到您为此付出了努力，所以我会做出更多贡献。我的目标是帮助您和任何阅读本文的人学习。

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

所以我给你两种方法。您找到了一种方法来实现前者，但为了以我上面的答案为基础，以下是我仅使用 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 位，则需要对其进行编辑。