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

我需要计算一个未知的复杂数组，并得到一个完美的重新计算的副本，而我不知道数组看起来如何。对于 例如：

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

虽然这很容易就能更好地解决问题，但它仍然显示了我的问题。只有一份拷贝不会让我把新的值放回去。仅假设1-D数组和值：

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

虽然这适用于1-D阵列，但不适用于n-D阵列。我仍然不知道我的阵列会是什么样子

对于未知数组是否有一种变通方法，或者是否有一种方法可以将每个…-循环的值放回

中

将
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
...

这是一个简单的二维数组，我的
Test2
无法用
MyArray（i）
处理它。这将导致一个错误。因此，每个答案都不可能像我的函数一样正确。
考虑一下：

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


更新

所以我看到你在努力，所以我会贡献更多。我在这里的目的是帮助你和任何阅读本文的人学习

正如我在第一次评论中提到的<代码>测试数组的秩需要错误处理或安全数组描述符查询。

所以我给你两种方法。您找到了一种实现前者的方法，但基于我上面的答案，以下是我仅使用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。我上面更新的答案显示了如何处理前两个维度。当然，更高的级别需要更多的案例

然而（正如我前面所说的），另一种方法是询问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位，则需要对其进行编辑。

此解决方案探索了处理多维数组和矩阵数组的方法

矩阵阵列（范围阵列）： 假设我们想将范围

B7:D12

乘以15，并将结果放在

H7:J12

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

图1

多维数组：

假设您有这个“原始”

数组

：

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

使用此功能处理“原始”

数组

，并获得结果

数组

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

本程序将并行打印两个阵列，以验证结果

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

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

这是多维“原始”数组

这是多维“aResult”数组

---

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

我的想法是只使用重定向到真实值的指针。。。强硬的。。。我不知道只有一个

数组怎么办

：（虽然我仍然不知道为什么ppl投票否决了我…我得到了我的答案…耶：DDoS不适用于超过1维的阵列…对不起，原始阵列有几个维！它已经过测试。请查看即时窗口。您遇到了什么样的错误？它是一个包含1维阵列的1维阵列。

array（x）（y）不是array（x，y）

与您的

a=Array（1，Array（2，3））

和MyArray=Array（15，22，Array（1，Array（7，3，9））示例相同正如我所写的，只需在那里测量1D数组

Test2

就可以了。但是，看第一个代码窗口，第二个或第三个示例不适用于它。引用：虽然这适用于一维数组，但不适用于n-D数组。我仍然不知道我的数组会是什么样子。当然，我提供了一个简单的示例。测试秩of数组需要错误处理或SAFEARRAY描述符查询。当然它不会这样。我说过它被简化了，你需要测试更高的秩并为它做准备。但是当然可以这样做。想想看。递归不是“仅仅”另一种方式。这是正确的方式。@DirkReichel请看一下我答案的更新。

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