传递给Sub过程的Array返回维度大小异常问题咨询

问题根源 #

你遇到的问题核心是错误使用Application.Run调用Sub过程，这个方法的参数传递机制会破坏动态数组的ByRef引用规则：

• Application.Run会将所有参数包装为Variant类型，默认按值（ByVal）传递，即便被调用过程声明为ByRef。
• 传递动态数组时，它不会传递数组引用，而是传递数组副本，并且会将多维数组强制转换为一维结构，导致你在test过程中检测到数组只有一维。

解决方案 #

将test过程中的Application.Run调用改为直接调用Sub过程，同时修正GetListItems中可能的溢出问题：

修改后的test过程

Sub test()
    Dim MyArray() As Variant
    Dim Dimension As Integer, Temp As Integer
    
    ' 直接调用Sub，而非用Application.Run
    GetListItems MyArray

    On Error GoTo Err
    Do While True
        Dimension = Dimension + 1
        Temp = UBound(MyArray, Dimension)
    Loop
Err:
    MsgBox "MyArray变量有 " & Dimension & " 个维度!", vbInformation + vbOKOnly
End Sub

优化后的GetListItems过程（修正LastRow类型）

Sub GetListItems(ByRef arrArray() As Variant)
    Dim WS As Worksheet
    ' 用Long替代Integer，避免行数超过32767时溢出
    Dim LastRow As Long
    Dim SelectedCols As String

    ' 初始化变量并获取数据库最后一行
    Set WS = Worksheets("Database")
    LastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row

    ' 定义要复制的非连续列范围
    SelectedCols = "A1:A" & LastRow & ", C1:C" & LastRow & _
                 ", F1:F" & LastRow & ", H1:H" & LastRow & _
                 ", V1:V" & LastRow & ", W1:W" & LastRow & _
                 ", X1:X" & LastRow & ", Z1:Z" & LastRow

    ' 复制粘贴数据到临时隐藏工作表
    WS.Range(SelectedCols).Copy
    Set WS = Worksheets.Add(, Sheets(Sheets.Count))
    With WS
        .Visible = xlSheetHidden
        .Paste WS.Range("A1")
    End With

    ' 将连续区域赋值给数组（二维数组）
    arrArray = WS.Range("A1").CurrentRegion

    ' 清理临时工作表
    With Application
        .CutCopyMode = False
        .DisplayAlerts = False
        WS.Delete
        .DisplayAlerts = True
    End With
End Sub

验证效果 #

修改后运行test过程，会弹出提示显示数组为2个维度，符合预期。

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