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

2024-04-10

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

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

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

data(*indices) 'I want this

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

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
);

通过一些内存技巧,您可以将多维数组视为一维数组。你会需要库内存 https://github.com/cristianbuse/VBA-MemoryTools/blob/master/src/LibMemory.bas:

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

Edit #1

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

如果我理解正确的话,最后一行将数组类型设置为与 arr 相同,但假数组的所有元素都指向原始 ByRef?

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

是否存在原始数据已经是 ByRef (VARIANTARGS 的参数数组?)的情况,而这不起作用?

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

Example:

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 and LetByRef或任何其他需要 ByRef Variant 作为参数的方法。

另外,为什么要采用数组 byref ?因为它是引用类型,所以 byval 不会进行浅复制,因此唯一的区别是现在您可以将 arr 设置为指向不同的数组吗?

因为我们不知道数组类型是什么(例如Long() or Variant())那么当我们传递给ArrayToFakeArray方法。传递包装数组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 结构的正确地址。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

从未知维度的多维数组中获取元素 的相关文章

随机推荐