如何在VBA中索引维度未知的多维数组？

你需要实现的是：当数组的维度数n仅在运行时可知时，通过一个长度为n的索引数组来动态索引n维数组，类似data(*indices)的效果。以下是两种可行的实现方案：

前提：获取数组维度数 #

首先可以用这个函数获取任意数组的维度数：

Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
    Const MAX_DIMENSION As Long = 60 ' VB数组的最大维度限制
    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

方案1：封装SafeArrayGetElement为易用的VBA函数 #

虽然直接调用SafeArrayGetElement API需要处理指针，但可以封装成通用函数，隐藏底层细节，直接传入数组和索引数组即可获取元素：

步骤1：声明API及封装函数 #

' 适配32/64位VBA的API声明
#If VBA7 Then
    Private Declare PtrSafe Function SafeArrayGetElement Lib "oleaut32.dll" ( _
        ByVal psa As LongPtr, _
        ByRef rgIndices As Long, _
        ByRef pv As Any _
    ) As Long
    
    Private Declare PtrSafe Function ObjPtr Lib "msvbvm60.dll" ( _
        ByRef obj As Any _
    ) As LongPtr
#Else
    Private Declare Function SafeArrayGetElement Lib "oleaut32.dll" ( _
        ByVal psa As Long, _
        ByRef rgIndices As Long, _
        ByRef pv As Any _
    ) As Long
    
    Private Declare Function ObjPtr Lib "msvbvm60.dll" ( _
        ByRef obj As Any _
    ) As Long
#End If

Public Function GetNDimArrayElement(ByRef arr As Variant, ByRef indices() As Long) As Variant
    Dim psa As LongPtr
    Dim element As Variant
    Dim hr As Long
    Dim dimCount As Long
    
    ' 校验索引数组长度与数组维度是否匹配
    dimCount = GetArrayDimsCount(arr)
    If dimCount <> (UBound(indices) - LBound(indices) + 1) Then
        Err.Raise vbObjectError + 1001, , "索引数组长度与数组维度不匹配"
    End If
    
    ' 获取数组的SafeArray指针
    psa = ObjPtr(arr)
    
    ' 调用API获取指定索引的元素
    hr = SafeArrayGetElement(psa, indices(LBound(indices)), element)
    If hr <> 0 Then
        Err.Raise vbObjectError + 1002, , "获取元素失败，错误码：" & hr
    End If
    
    GetNDimArrayElement = element
End Function

使用示例 #

Sub TestAPIMethod()
    Dim data(1 To 2, 1 To 3, 1 To 4) As Integer
    Dim indices(1 To 3) As Long
    Dim result As Variant
    
    ' 填充测试数据
    data(1, 2, 3) = 123
    
    ' 设置索引
    indices(1) = 1
    indices(2) = 2
    indices(3) = 3
    
    ' 获取元素
    result = GetNDimArrayElement(data, indices)
    Debug.Print result ' 输出：123
End Sub

优势：支持所有类型的数组（包括固定长度数组、动态数组），性能优异，兼容性强。

方案2：使用Eval动态构建索引表达式 #

如果你的数组是Variant类型，可以通过构建索引字符串，用Eval函数动态执行索引操作，无需API：

封装函数 #

Public Function GetNDimElementByEval(ByRef arr As Variant, ByRef indices() As Long) As Variant
    Dim dimCount As Long
    Dim indexStr As String
    Dim i As Long
    
    dimCount = GetArrayDimsCount(arr)
    If dimCount <> (UBound(indices) - LBound(indices) + 1) Then
        Err.Raise vbObjectError + 1001, , "索引数组长度与数组维度不匹配"
    End If
    
    ' 构建索引字符串（如"1,2,3"）
    indexStr = CStr(indices(LBound(indices)))
    For i = LBound(indices) + 1 To UBound(indices)
        indexStr = indexStr & "," & CStr(indices(i))
    Next i
    
    ' 动态执行索引
    GetNDimElementByEval = Eval("arr(" & indexStr & ")")
End Function

使用示例 #

Sub TestEvalMethod()
    Dim data As Variant
    Dim indices(1 To 3) As Long
    Dim result As Variant
    
    ' 初始化基于0的三维Variant数组
    data = Array(Array(Array(1, 2), Array(3, 4)), Array(Array(5, 6), Array(7, 8)))
    
    ' 设置对应索引
    indices(1) = 1
    indices(2) = 0
    indices(3) = 1
    
    ' 获取元素
    result = GetNDimElementByEval(data, indices)
    Debug.Print result ' 输出：6
End Sub

优势：无需API声明，代码更简洁；局限性：仅支持Variant数组，性能略低于API方案，不适合大数据量场景。

内容的提问来源于stack exchange，提问作者Greedo