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

虽然这适用于1-D阵列，但它不适用于n-D阵列。而且我仍然不知道我的阵列是怎样的。

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

将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)处理它。这将导致错误。所以每个答案都像我的功能一样做得不正确。

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

<强>更新

所以我看到你的工作，所以我会贡献更多。我的目标是帮助您和阅读此内容的任何人学习。

正如我在第一条评论中提到的那样...... 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，您必须使用硬编码开关，例如Select Case，因为VBA数组元素\ rank索引的实现方式。我上面的更新答案显示了如何使用前两个维度。它当然需要更高级别的其他案例。

然而（并且就像我前面说的那样）另一种方法是询问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

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

Answer 2

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

矩阵阵列（范围数组）： 假设我们想将范围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

多维数组：

假设你有＆＃34; Original＆＃34; 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

使用此功能处理＆＃34;原创＆＃34; 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

此程序可并行打印两个数组以验证结果

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

处理＆＃34;原创＆＃34;并打印＆＃34;结果＆＃34;

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

这是多维的＆＃34; aOriginal＆＃34;阵列

这是多维的＆＃34; aResult＆＃34;阵列

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

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

2 个答案: