创建一个空的二维数组

Question

我不喜欢未初始化的 VBA 数组，因为每次使用之前都需要检查数组是否已初始化UBound()或For Each避免异常，并且没有本机 VBA 函数来检查它。这就是为什么我初始化数组，至少用a = Array(). 这在大多数情况下消除了额外检查的需要，因此一维数组没有问题。

出于同样的原因，我尝试创建一个空的二维数组。不可能简单地做ReDim a(0 To -1, 0 To 0)，转置一维空数组或类似的东西。我偶然遇到的唯一方法是使用MSForms.ComboBox，将空数组分配给.List属性并将其读回。这是在 Excel 和 Word 中工作的示例，您需要插入UserForm到 VBA 项目中，放置ComboBox在其上，并添加以下代码：

Private Sub ComboBox1_Change()

    Dim a()
    ComboBox1.List = Array()
    a = ComboBox1.List
    Debug.Print "1st dimension upper bound = " & UBound(a, 1)
    Debug.Print "2nd dimension upper bound = " & UBound(a, 2)

End Sub

组合更改后的输出为：

1st dimension upper bound = -1
2nd dimension upper bound = 0

实际上它实际上是调试中的空二维数组：

是否有更优雅的方法来创建一个空的二维数组，而不使用ComboBox, 或UserForm一般控件？

Answer 1

这仅适用于 Windows（不适用于 Mac）：

Option Explicit

#If Mac Then
#Else
    #If VBA7 Then
        Private Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
        Private Declare PtrSafe Function VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any) As Long
        Private Declare PtrSafe Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As LongPtr) As Long
    #Else
        Private Declare Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As Long
        Private Declare Function VariantCopy Lib "OleAut32.dll" (pvargDest As Variant, pvargSrc As Any) As Long
        Private Declare Function SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As Long) As Long
    #End If
#End If

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type tagVariant
    vt As Integer
    wReserved1 As Integer
    wReserved2 As Integer
    wReserved3 As Integer
    #If VBA7 Then
        ptr As LongPtr
    #Else
        ptr As Long
    #End If
End Type

Public Function EmptyArray(ByVal numberOfDimensions As Long, ByVal vType As VbVarType) As Variant
    'In Visual Basic, you can declare arrays with up to 60 dimensions
    Const MAX_DIMENSION As Long = 60
    
    If numberOfDimensions < 1 Or numberOfDimensions > MAX_DIMENSION Then
        Err.Raise 5, "EmptyArray", "Invalid number of dimensions"
    End If

    #If Mac Then
        Err.Raise 298, "EmptyArray", "OleAut32.dll required"
    #Else
        Dim bounds() As SAFEARRAYBOUND
        #If VBA7 Then
            Dim ptrArray As LongPtr
        #Else
            Dim ptrArray As Long
        #End If
        Dim tVariant As tagVariant
        Dim i As Long
        '
        ReDim bounds(0 To numberOfDimensions - 1)
        '
        'Make lower dimensions [0 to 0] instead of [0 to -1]
        For i = 1 To numberOfDimensions - 1
            bounds(i).cElements = 1
        Next i
        '
        'Create empty array and store pointer
        ptrArray = SafeArrayCreate(vType, numberOfDimensions, bounds(0))
        '
        'Create a Variant pointing to the array
        tVariant.vt = vbArray + vType
        tVariant.ptr = ptrArray
        '
        'Copy result
        VariantCopy EmptyArray, tVariant
        '
        'Clean-up
        SafeArrayDestroy ptrArray
    #End If
End Function

您现在可以创建具有不同维数和数据类型的空数组：

Sub Test()
    Dim arr2D() As Variant
    Dim arr4D() As Double
    '
    arr2D = EmptyArray(2, vbVariant)
    arr4D = EmptyArray(4, vbDouble)
    Stop
End Sub

更新日期 30/09/2022

我在 GitHub 上的MemoryToolsEmptyArray库中创建了一个方法（相同的签名）。该版本适用于 Windows 和 Mac。

Answer 2

我不知道，我认为你偶然发现这个房产是相当疯狂的。

我可能会在这里停下来，然后这样做：

Function Empty2DArray() As Variant
With CreateObject("Forms.ComboBox.1")
    .List = Array()
    Empty2DArray = .List
End With
End Function

并像这样使用它：a = Empty2DArray

您不需要创建用户表单或组合框 - 您只需使用CreateObject.

但正如其他人所说，在检查数组是否已初始化时进行错误处理可能更有意义。