Get element from multidimensional array with unknown dimensions-CodePudding

If I have an array with n-dimensions, where n is an unknown number until runtime, how do I index into that array?

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

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

data(*indices) 'I want this

(we can work out n using this 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

The following does what I want I think but I was wondering is there an obvious way to do this in VBA (*pv void looks like a headache)

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

CodePudding user response：

With a bit of memory trickery you can look at your multidimensional array as a one dimensional array. You will need 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

Quick test:

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