Office VBA 如何编写可处理任意维度数组的通用遍历函数

核心原理 #

硬编码的痛点本质是默认必须在编写代码时固定括号内的索引个数，VBA本身有两个原生特性可以绕开这个限制：

• 数组的成员访问本质是带参数的属性调用，支持将存储了N个索引值的一维Variant数组直接作为入参传入，VBA会自动将其展开为对应个数的位置索引，不需要硬写Arr(1,1,...)这类语法。
• 任意维度的多维数组，本质上都是“低一维的子数组的集合”，可以通过逐层展开的逻辑实现全量元素遍历，不需要提前获知总维度数。

完整实现流程 #

1. 基础工具函数实现 #

首先实现两个无依赖的辅助函数，为后续动态逻辑提供支撑：

• 获取数组实际维度数，非数组类型返回0：

Function GetArrayDims(ByVal Target As Variant) As Long
    If Not IsArray(Target) Then Exit Function
    Dim DimIdx As Long, TempBound As Long
    On Error Resume Next
    ' VBA原生最大支持60维，远高于常规场景的20维上限
    For DimIdx = 1 To 60
        Err.Clear
        TempBound = UBound(Target, DimIdx)
        If Err.Number <> 0 Then Exit For
    Next
    On Error GoTo 0
    GetArrayDims = DimIdx - 1
End Function

• 严格判断变量是否为数组，避免对象类型的误判：

Function IsReallyArray(ByVal Target As Variant) As Boolean
    IsReallyArray = IsArray(Target) And Not IsObject(Target)
End Function

2. 核心遍历逻辑实现 #

以下两种方案任选其一即可，都不需要维护任何维度分支判断：

方案1：索引进位法（性能最优）

提前缓存每个维度的上下界，通过类似计数器进位的方式逐组生成索引，通过动态参数传递完成元素访问，逻辑和总维度数完全解耦。以原示例中统计数组元素总数的需求为例，代码如下：

Function WorkWithArray(ByVal InputArray As Variant) As Long
    Dim TotalDims As Long
    TotalDims = GetArrayDims(InputArray)
    If TotalDims = 0 Then Exit Function
    
    ' 缓存每个维度的上下界
    Dim DimLower() As Long, DimUpper() As Long
    ReDim DimLower(1 To TotalDims)
    ReDim DimUpper(1 To TotalDims)
    Dim i As Long
    For i = 1 To TotalDims
        DimLower(i) = LBound(InputArray, i)
        DimUpper(i) = UBound(InputArray, i)
    Next
    
    ' 存储当前每维的索引位置，初始化为每个维度的下界值
    Dim CurIndex() As Long
    ReDim CurIndex(1 To TotalDims)
    For i = 1 To TotalDims
        CurIndex(i) = DimLower(i)
    Next
    
    Dim ElementCount As Long
    Do
        ' 动态读取元素：直接将索引数组作为参数传入，VBA会自动展开为对应个数的位置索引
        Dim CurrentValue As Variant
        CurrentValue = InputArray(CurIndex)
        ' 此处替换为实际业务的元素处理逻辑
        ElementCount = ElementCount + 1
        
        ' 索引进位逻辑：从最后一维开始逐位累加，触发边界则向前一维进位
        Dim CarryPos As Long
        CarryPos = TotalDims
        Do While CarryPos >= 1
            CurIndex(CarryPos) = CurIndex(CarryPos) + 1
            If CurIndex(CarryPos) <= DimUpper(CarryPos) Then Exit Do
            ' 当前维度到达上界，重置为下界并向前进位
            CurIndex(CarryPos) = DimLower(CarryPos)
            CarryPos = CarryPos - 1
        Loop
        ' 进位至第0位时，说明所有维度的元素已遍历完成
    Loop While CarryPos >= 1
    
    WorkWithArray = ElementCount
End Function

该方案的运行性能和硬编码的固定维度遍历几乎无差距，因为索引展开是VBA原生的参数传递逻辑，没有额外的内存拷贝开销。

方案2：递归展开法（代码最简洁）

利用多维数组的嵌套结构，从第一维开始逐层递归判断，直到取得单值元素为止，全程不需要提前计算总维度数，对特殊数组类型的兼容性最好：

' 递归遍历的核心逻辑
Sub TraverseNested(ByVal Target As Variant, ByRef ProcessedCount As Long)
    If IsReallyArray(Target) Then
        ' 当前值是数组则遍历本层的所有元素，递归进入下一层
        Dim i As Long
        For i = LBound(Target) To UBound(Target)
            TraverseNested Target(i), ProcessedCount
        Next
    Else
        ' 拿到单值元素，此处替换为实际业务的处理逻辑
        ProcessedCount = ProcessedCount + 1
    End If
End Sub

' 对外暴露的通用入口
Function WorkWithArray(ByVal InputArray As Variant) As Long
    If Not IsArray(InputArray) Then Exit Function
    Dim Total As Long
    TraverseNested InputArray, Total
    WorkWithArray = Total
End Function

常见注意事项 #

• 数组在VBA中默认按引用传递，遍历过程中修改读取到的元素值，会直接改动原数组内容。
• 上述逻辑会自动适配非默认下标的数组（比如下标从0、-3这类非1起始的数组），不需要额外调整代码。
• 如果传入的是用户自定义类型（UDT）的数组，动态索引传参的方式会触发类型错误，这类场景优先选择递归展开法实现。

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