在 VBA 中声明一个长度为 0 的字符串数组 - 不可能？

Question

真的不能在VBA中声明一个长度为0的数组吗？如果我试试这个：

Dim lStringArr(-1) As String

我收到一个编译错误，提示范围没有值。如果我尝试像这样在运行时欺骗编译器并重新调整：

ReDim lStringArr(-1)

我收到下标超出范围的错误。

我对上面的内容做了一些改动，但没有成功，例如

Dim lStringArr(0 To -1) As String

用例

我想将变体数组转换为字符串数组。变体数组可能为空，因为它来自字典的 Keys 属性。键属性返回一个变体数组。我想在我的代码中使用一个字符串数组，因为我有一些函数可以处理我想使用的字符串数组。这是我正在使用的转换函数。由于 lMaxIndex = -1:

，这会引发下标超出范围错误

Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
    Dim lStringArr() As String
    Dim lMaxIndex As Long, lMinIndex As Long
    lMaxIndex = UBound(pVariants)
    lMinIndex = LBound(pVariants)
    ReDim lStringArr(lMaxIndex)
    Dim lVal As Variant
    Dim lIndex As Long
    For lIndex = lMinIndex To lMaxIndex
        lStringArr(lIndex) = pVariants(lIndex)
    Next
    mVariantArrayToStringArray = lStringArr
End Function

破解

Return 一个包含空字符串的单例数组。注意——这不是我们想要的。我们想要一个空数组——这样遍历它就像什么都不做。但是包含空字符串的单例数组通常可以工作，例如如果我们稍后想将所有字符串连接到字符串数组中。

Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
    Dim lStringArr() As String
    Dim lMaxIndex As Long, lMinIndex As Long
    lMaxIndex = UBound(pVariants)
    lMinIndex = LBound(pVariants)
    If lMaxIndex < 0 Then
        ReDim lStringArr(1)
        lStringArr(1) = ""
    Else
        ReDim lStringArr(lMaxIndex)
    End If
    Dim lVal As Variant
    Dim lIndex As Long
    For lIndex = lMinIndex To lMaxIndex
        lStringArr(lIndex) = pVariants(lIndex)
    Next
    mVariantArrayToStringArray = lStringArr
End Function

回答后更新

这是我用来将变体数组转换为字符串数组的函数。 Comintern 的解决方案似乎更高级和通用，如果我仍然坚持编码 VBA:

，我可能有一天会切换到那个

Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
    Dim lStringArr() As String
    Dim lMaxIndex As Long, lMinIndex As Long
    lMaxIndex = UBound(pVariants)
    lMinIndex = LBound(pVariants)
    If lMaxIndex < 0 Then
        mVariantArrayToStringArray = Split(vbNullString)
    Else
        ReDim lStringArr(lMaxIndex)
    End If
    Dim lVal As Variant
    Dim lIndex As Long
    For lIndex = lMinIndex To lMaxIndex
        lStringArr(lIndex) = pVariants(lIndex)
    Next
    mVariantArrayToStringArray = lStringArr
End Function

备注

我使用 Option Explicit。这无法更改，因为它会保护模块中的其余代码。

Answer 1

每 .

创建一个专用实用程序函数，return 是 VBA.Strings.Split 函数的结果，处理 vbNullString，它实际上是一个空字符串指针，这使得意图更加明确比使用空字符串文字 "" 还有效：

Public Function EmptyStringArray() As String()
     EmptyStringArray = VBA.Strings.Split(vbNullString)
End Function

现在分支您的函数以检查键是否存在，如果存在 none return EmptyStringArray，则继续调整结果数组的大小并转换每个源元素。

Answer 2

如评论中所述，您可以通过在 vbNullString 上调用 Split 来执行此操作 "natively"，如 documented here:

expression - Required. String expression containing substrings and delimiters. If expression is a zero-length string(""), Split returns an empty array, that is, an array with no elements and no data.

如果您需要更通用的解决方案（即其他数据类型，您可以直接调用 oleaut32.dll 中的 SafeArrayRedim 函数并请求它重新调整传递的数组的维度为 0 个元素。您确实必须跳过几个环节才能获得数组的基地址（这是由于 VarPtr 函数的一个怪癖）。

在模块声明部分：

'Headers
Private Type SafeBound
    cElements As Long
    lLbound As Long
End Type

Private Const VT_BY_REF = &H4000&
Private Const PVDATA_OFFSET = 8

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
    ByVal length As Long)

Private Declare Sub SafeArrayRedim Lib "oleaut32" (ByVal psa As LongPtr, _
    ByRef rgsabound As SafeBound)

该过程 - 向其传递一个初始化数组（任何类型），它将从中删除所有元素：

Private Sub EmptyArray(ByRef vbArray As Variant)
    Dim vtype As Integer
    CopyMemory vtype, vbArray, LenB(vtype)
    Dim lp As LongPtr
    CopyMemory lp, ByVal VarPtr(vbArray) + PVDATA_OFFSET, LenB(lp)
    If Not (vtype And VT_BY_REF) Then
        CopyMemory lp, ByVal lp, LenB(lp)
        Dim bound As SafeBound
        SafeArrayRedim lp, bound
    End If
End Sub

示例用法：

Private Sub Testing()
    Dim test() As Long
    ReDim test(0)
    EmptyArray test
    Debug.Print LBound(test)    '0
    Debug.Print UBound(test)    '-1
End Sub

Answer 3

如果我们无论如何都要使用 WinAPI，我们也可以使用 WinAPI SafeArrayCreate 函数从头开始干净地创建数组，而不是重新定义它。

结构声明：

Public Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Public Type tagVariant
    vt As Integer
    wReserved1 As Integer
    wReserved2 As Integer
    wReserved3 As Integer
    pSomething As LongPtr
End Type

WinAPI 声明：

Public Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Public Declare PtrSafe Sub VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any)
Public Declare PtrSafe Sub SafeArrayDestroy Lib "OleAut32.dll"(ByVal psa As LongPtr)

使用它：

Public Sub Test()
    Dim bounds As SAFEARRAYBOUND 'Defaults to lower bound 0, 0 items
    Dim NewArrayPointer As LongPtr 'Pointer to hold unmanaged string array
    NewArrayPointer = SafeArrayCreate(vbString, 1, bounds)
    Dim tagVar As tagVariant 'Unmanaged variant we can manually manipulate
    tagVar.vt = vbArray + vbString 'Holds a string array
    tagVar.pSomething = NewArrayPointer 'Make variant point to the new string array
    Dim v As Variant 'Actual variant
    VariantCopy v, ByVal tagVar 'Copy unmanaged variant to managed one
    Dim s() As String 'Managed string array
    s = v 'Copy the array from the variant
    SafeArrayDestroy NewArrayPointer 'Destroy the unmanaged SafeArray, leaving the managed one
    Debug.Print LBound(s); UBound(s) 'Prove the dimensions are 0 and -1    
End Sub

Answer 4

SafeArrayCreateVector

另一个选项，在别处的答案中提到，^{1 2} SafeArrayCreateVector。虽然 SafeArrayCreate returns 是一个指针，如 Erik A 所示，但这个 returns 直接是一个数组。每种类型都需要一个声明，如下所示：

 Private Declare PtrSafe Function VectorBoolean Lib "oleaut32" Alias "SafeArrayCreateVector" ( _
 Optional ByVal vt As VbVarType = vbBoolean, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) _
 As Boolean()
 
 Private Declare PtrSafe Function VectorByte Lib "oleaut32" Alias "SafeArrayCreateVector" ( _
 Optional ByVal vt As VbVarType = vbByte, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) _
 As Byte()

同样适用于 Currency、Date、Double、Integer、Long、LongLong、Object , Single, String 和 Variant.

如果您愿意将它们塞进一个模块中，您可以创建一个函数，其工作方式与 Array() 类似，但带有一个设置类型的初始参数：

Function ArrayTyped(vt As VbVarType, ParamArray argList()) As Variant
    
    Dim ub As Long: ub = UBound(argList) + 1
    Dim ret As Variant 'a variant to hold the array to be returned

    Select Case vt
        Case vbBoolean: Dim bln() As Boolean: bln = VectorBoolean(, , ub): ret = bln
        Case vbByte: Dim byt() As Byte: byt = VectorByte(, , ub): ret = byt
        Case vbCurrency: Dim cur() As Currency: cur = VectorCurrency(, , ub): ret = cur
        Case vbDate: Dim dat() As Date: dat = VectorDate(, , ub): ret = dat
        Case vbDouble: Dim dbl() As Double: dbl = VectorDouble(, , ub): ret = dbl
        Case vbInteger: Dim i() As Integer: i = VectorInteger(, , ub): ret = i
        Case vbLong: Dim lng() As Long: lng = VectorLong(, , ub): ret = lng
        Case vbLongLong: Dim ll() As LongLong: ll = VectorLongLong(, , ub): ret = ll
        Case vbObject: Dim obj() As Object: obj = VectorObject(, , ub): ret = obj
        Case vbSingle: Dim sng() As Single: sng = VectorSingle(, , ub): ret = sng
        Case vbString: Dim str() As String: str = VectorString(, , ub): ret = str
    End Select
    
    Dim argIndex As Long
    For argIndex = 0 To ub - 1
        ret(argIndex) = argList(argIndex)
    Next
    
    ArrayTyped = ret
    
End Function

这会给出空数组或填充数组，例如 Array()。例如：

Dim myLongs() as Long
myLongs = ArrayTyped(vbLong, 1,2,3) '<-- populated Long(0,2)

Dim Pinnochio() as String
Pinnochio = ArrayTyped(vbString) '<-- empty String(0,-1)

与 SafeArrayRedim 相同的 ArrayTyped() 函数

我喜欢这个函数，但是对每种类型的所有 API 调用似乎都显得臃肿。似乎可以用 SafeArrayRedim 完成相同的功能，并且只需一个 API 调用。如此声明：

Private Declare PtrSafe Function PtrRedim Lib "oleaut32" Alias "SafeArrayRedim" (ByVal arr As LongPtr, ByRef dims As Any) As Long

相同的 ArrayTyped 函数可能如下所示：

Function ArrayTyped(vt As VbVarType, ParamArray argList()) As Variant
    
    Dim ub As Long: ub = UBound(argList) + 1
    Dim ret As Variant 'a variant to hold the array to be returne
    
    Select Case vt
        Case vbBoolean: Dim bln() As Boolean: ReDim bln(0): PtrRedim Not Not bln, ub: ret = bln
        Case vbByte: Dim byt() As Byte: ReDim byt(0): PtrRedim Not Not byt, ub: ret = byt
        Case vbCurrency: Dim cur() As Currency: ReDim cur(0): PtrRedim Not Not cur, ub: ret = cur
        Case vbDate: Dim dat() As Date: ReDim dat(0): PtrRedim Not Not dat, ub: ret = dat
        Case vbDouble: Dim dbl() As Double: ReDim dbl(0): PtrRedim Not Not dbl, ub: ret = dbl
        Case vbInteger: Dim i() As Integer: ReDim i(0): PtrRedim Not Not i, ub: ret = i
        Case vbLong: Dim lng() As Long: ReDim lng(0): PtrRedim Not Not lng, ub: ret = lng
        Case vbLongLong: Dim ll() As LongLong: ReDim ll(0): PtrRedim Not Not ll, ub: ret = ll
        Case vbObject: Dim obj() As Object: ReDim obj(0): PtrRedim Not Not obj, ub: ret = obj
        Case vbSingle: Dim sng() As Single: ReDim sng(0): PtrRedim Not Not sng, ub: ret = sng
        Case vbString: Dim str() As String: ReDim str(0): PtrRedim Not Not str, ub: ret = str
        Case vbVariant: Dim var() As Variant: ReDim var(0): PtrRedim Not Not var, ub: ret = var
    End Select
    
    Dim argIndex As Long
    For argIndex = 0 To ub - 1
        ret(argIndex) = argList(argIndex)
    Next
    
    ArrayTyped = ret
    
End Function

一些其他资源：

遵循逻辑 here you can also do this with user defined types. Just add another API call like the others. More discussion here。
如果有人想要多维度的空容器，还有另一种有趣的方法使用 SafeArrayCreate 。

在 VBA 中声明一个长度为 0 的字符串数组 - 不可能？

Declare a 0-Length String Array in VBA - Impossible?

arrays

vba

zero

用例

破解

回答后更新

备注