arrays - 从未知维度的多维数组中获取元素

Question

如果我有一个 n 维数组，其中 n 在运行时之前是未知数，我如何索引该数组？

ReDim indices(1 to n) As Long = array(1,2,3)

data(1,2,3) 'n = 3

data(*indices) 'I want this

(我们可以使用此 https://github.com/cristianbuse/VBA-ArrayTools/blob/c23cc6ba550e7ebaed1f26808501ea3afedf1a3b/src/LibArrayTools.bas#L730-L741 计算出 n )

Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
    Const MAX_DIMENSION As Long = 60 'VB limit
    Dim dimension As Long
    Dim tempBound As Long
    '
    On Error GoTo FinalDimension
    For dimension = 1 To MAX_DIMENSION
        tempBound = LBound(arr, dimension)
    Next dimension
FinalDimension:
    GetArrayDimsCount = dimension - 1
End Function

以下内容符合我的想法，但我想知道在 VBA 中是否有一种明显的方法可以做到这一点(*pv void 看起来很头痛)

HRESULT SafeArrayGetElement(
  [in]  SAFEARRAY *psa,
  [in]  LONG      *rgIndices,
  [out] void      *pv
);

Answer 1

通过一些内存技巧，您可以将多维数组视为一维数组。您将需要LibMemory :

Option Explicit

Public Type FAKE_ARRAY
    sArr As SAFEARRAY_1D
    fakeArrPtr As LongPtr
    values As Variant
End Type

Public Sub ArrayToFakeArray(ByRef arr As Variant, ByRef fakeArray As FAKE_ARRAY)
    Dim aptr As LongPtr: aptr = ArrPtr(arr) 'Will throw if not array
    Dim i As Long
    '
    With fakeArray
        .fakeArrPtr = VarPtr(.sArr)
        MemCopy .fakeArrPtr, aptr, LenB(.sArr)
        With .sArr.rgsabound0
            .cElements = 1
            For i = 1 To fakeArray.sArr.cDims
                .cElements = .cElements * (UBound(arr, i) - LBound(arr, i) + 1)
            Next i
        End With
        .sArr.cDims = 1
        .values = VarPtr(.fakeArrPtr)
        MemInt(VarPtr(.values)) = VarType(arr) Or VT_BYREF
    End With
End Sub

快速测试:

Sub Test()
    Dim arr(2, 3, 2) As Variant
    Dim i As Long, j As Long, k As Long
    Dim m As Long
    Dim v As Variant
    '
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            For k = LBound(arr, 3) To UBound(arr, 3)
                arr(i, j, k) = m
                m = m + 1
            Next k
        Next j
    Next i
    '
    Dim temp As FAKE_ARRAY: ArrayToFakeArray arr, temp
    '
    Dim arr2(1, 1) As Double
    arr2(1, 1) = 17.55
    '
    Dim temp2 As FAKE_ARRAY: ArrayToFakeArray arr2, temp2
    '
    Debug.Print temp.values(0)
    Debug.Print temp.values(4)  '15
    Debug.Print temp.values(35)
    '
    arr(1, 1, 0) = "AAA"
    Debug.Print temp.values(4)  'AAA
    Debug.Print temp2.values(3)
End Sub

编辑#1

这是对OP在评论部分提出的一系列有趣问题的回应。不仅响应太长，而且它绝对应该是答案的一部分。

If I'm understanding correctly, the last line sets the array type as the same as arr but all the elements of the fake one point to the original ByRef?

复制 SAFEARRAY 结构时，我们还复制 pvData指向实际数据的指针。假数组指向内存中的相同数据，因此我们欺骗数组处理代码直接读取该数据(而不是 ByRef)。但是，我们需要在values上设置ByRef标志。避免两次释放相同内存而导致崩溃的变体。但到目前为止，没有什么是 ByRef - 只是 2 个数组变量指向相同的数据。

Could there be a situation where the original is already ByRef (paramarray of VARIANTARGS?) and this doesn't work?

如果原始数据具有 ByRef 成员(VARIANTARGS 的参数数组)，则只有当我们使用类似 CloneParamArray 之类的内容时才会发生这种情况方法，因为否则 VB 不允许传递 param 数组，至少本地不允许。在这种情况下，通过假数组访问 ByRef 成员只能通过可以接收此类成员 ByRef 的实用程序函数正确完成。

示例:

Sub Test()
    Dim t As Long: t = 5
    
    ToParam 1, 2, 3, 4, t
    
    Debug.Print t
End Sub

Public Sub ToParam(ParamArray args() As Variant)
    Dim arr() As Variant
    CloneParamArray args(0), UBound(args) + 1, arr
    
    Dim temp As FAKE_ARRAY: ArrayToFakeArray arr, temp
    
    Debug.Print arr(4)
'    Debug.Print temp.values(4) 'Err 458 - type not supported
    PrintVar temp.values(4)

    args(4) = 7
    
    Debug.Print arr(4)
    PrintVar temp.values(4)
    
    LetByRef(temp.values(4)) = 9
    
    Debug.Print arr(4)
    PrintVar temp.values(4)
End Sub

Private Function PrintVar(ByRef v As Variant)
    Debug.Print v
End Function

Private Property Let LetByRef(ByRef vLeft As Variant, ByVal vRight As Variant)
    vLeft = vRight
End Property

如果使用 CloneParamArray无论如何，人们应该意识到 ByRef 个人变体成员只能通过实用方法(例如 PrintVar)访问/更改和LetByRef或任何其他需要 ByRef Variant 作为参数的方法。

Also, why do you take the array byref? Because it's a reference type, byval doesn't make a shallow copy so the only difference is now you can set arr to point to a different array?

因为我们不知道数组类型是什么(例如 Long() 或 Variant() )，所以当我们传递给 ArrayToFakeArray 时，我们显然必须包装在 Variant 中。方法。传递包装数组 ByVal确实制作了副本，我们可以通过运行以下命令看到:

Option Explicit

Sub Test()
    Dim arr() As Long
    ReDim arr(0 To 1)
    arr(0) = 12
    arr(1) = 44
    '
    PassArr arr, arr
    Debug.Print
    Debug.Print arr(1) 'Prints 55
End Sub

Private Sub PassArr(ByVal arrByVal As Variant, ByRef arrByRef As Variant)
    #If Win64 Then
        Const dataOffset As Long = 16
    #Else
        Const dataOffset As Long = 12
    #End If
    Dim aPtrByVal As LongPtr: aPtrByVal = ArrPtr(arrByVal)
    Dim aPtrByRef As LongPtr: aPtrByRef = ArrPtr(arrByRef)
    Dim pvDataByVal As LongPtr: pvDataByVal = MemLongPtr(aPtrByVal + dataOffset)
    Dim pvDataByRef As LongPtr: pvDataByRef = MemLongPtr(aPtrByRef + dataOffset)
    '
    Debug.Print "ByVal SAFEARRAY address:", aPtrByVal, "ByVal data address:", pvDataByVal
    Debug.Print "ByRef SAFEARRAY address:", aPtrByRef, "ByRef data address:", pvDataByRef
    '
    Debug.Print MemLong(pvDataByVal + 4) 'Prints 44
    Debug.Print MemLong(pvDataByRef + 4) 'Prints 44
    '
    arrByRef(1) = 55
    '
    Debug.Print MemLong(pvDataByVal + 4) 'Prints 44
    Debug.Print MemLong(pvDataByRef + 4) 'Prints 55
    '
    arrByVal(1) = 77
    '
    Debug.Print MemLong(pvDataByVal + 4) 'Prints 77
    Debug.Print MemLong(pvDataByRef + 4) 'Prints 55
End Sub

因此，我们需要传递包装后的数组 ByRef这样ArrPtr返回 SAFEARRAY 结构的正确地址。