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

Question

在VBA中，是否真的无法声明长度为0的数组？ 如果我尝试这样做：

Dim lStringArr(-1) As String

我收到一个编译错误，提示range没有值。如果我尝试欺骗编译器并像这样在运行时重新定义大小： ```vb Redim Preserve range(1 to 0) ```

ReDim lStringArr(-1)

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

我已经尝试过一些变化，但是没有成功，例如：

Dim lStringArr(0 To -1) As String

用例

我想将变体数组转换为字符串数组。变体数组可能为空，因为它来自字典的Keys属性。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

黑客

返回一个只包含空字符串的单例数组。注意- 这不是我们想要的。我们想要一个空数组- 这样循环它就像什么也没有做一样。但是，一个只包含空字符串的单例数组通常会起作用，例如如果我们稍后想把所有字符串连接在一起。

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。这不能更改，因为它可以保护模块中其余的代码。

- Colm Bhandal

---

以下代码有效：Dim a(-1 To 0) As Variant。 - Nathan_Sav

若仅声明数组而未指定大小，该数组将保持“空”。但是，在进行重新调整大小之前尝试访问它将导致错误（即声明为“Dim test() As String”）。 - bassfader

我猜 Dim results As Variant 不太可行？传递类型化数组总是很麻烦的，我早就决定要选择自己的战斗，并对任何类型的数组使用 Variant。在变量数组中，变量子类型 String 是否存在？如果是这样，那么你正在进行不必要的处理。 - Mathieu Guindon

arrOutput = Split(vbNullString) 会生成一个下边界为0，上边界为-1的数组。这已经是最接近操作内存的方式了。 - Comintern

^^ @Comintern所说的。将您的函数分支以检查键的存在，并在没有键的情况下返回Split(vbNullString)，否则继续redim并转换每个元素。实际上，我会创建一个名为EmptyStringArray的函数并调用它，只返回这个。 - Mathieu Guindon

Answer 1

正如评论中所提到的，您可以在vbNullString上调用Split函数来实现“本地化”，具体请参见此文档：

expression - 必需。包含子字符串和分隔符的字符串表达式。如果 expression 是零长度字符串（""），则 Split 返回一个空数组，即一个没有元素和数据的数组。

如果您需要更通用的解决方案（即其他数据类型），您可以直接调用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

- Comintern

---

你是不是真的想把 SafeArrayRedim 放在 Not (vtype And VT_BY_REF) 检查的内部？ - GSerg

你可以通过使用 Public Declare PtrSafe Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As LongPtr 访问数组指针来简化这段代码，而不是手动复制内存，并将字符串数组作为 EmptyArray 函数的参数。 - Erik A

@ErikA 这对于例如字符串或UDT的数组是行不通的，因为VB在将它们传递给Declare函数之前会转换字符串，因此VarPtrArray将返回无用临时转换副本的地址。 - GSerg

另外，RtlMoveMemory 的第三个参数是 SIZE_T，它是 LongPtr。SafeArrayRedim 返回一个 Long，也应该是 PtrSafe。 - GSerg

Answer 2

根据共产国际的评论。

创建一个专用的实用函数，返回VBA.Strings.Split函数的结果，使用vbNullString作为参数，它是有效的空字符串指针，这比使用空字符串字面量""更明确，后者也可以工作：

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

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

- Mathieu Guindon

---

有趣的是，如果楼主按照评论中建议的选择使用不带类型的选项，那么只需调用Array()而无需参数即可。 - GSerg

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

- Erik A

---

这样不会泄漏数组的内存吗？我认为使用SafeArrayCreate创建的数组必须使用SafeArrayDestroy释放。 - Comintern

@Comintern 你是100%正确的，s确实包含了数组的副本，原始的长度为0的数组并没有被销毁。现在已经进行了调整。 - Erik A

我非常确定SafeArrayDestroy是VB正常情况下销毁其创建的数组的方法，因此不应该有任何区别，它应该在检测到数组变量具有非零指针时调用。但是如果您创建一个引用现有数组部分的数组，则调用SafeArrayDestroy非常重要。 - GSerg

Answer 4

你可以声明一个变量长度的数组，无需在 Dim 中指定长度，以便声明所需类型。然后使用数组变量调用 IsArray。它将返回 True，但我们对此不感兴趣，这只是初始化数组。

Dim lStringArr() As String

' Call IsArray to initialise the array
IsArray lStringArr

' Print the amount of elements in the array to the Immediate window
Debug.Print UBound(lStringArr) - LBound(lStringArr) + 1
' It should print 0 without errors

- Paco Verschut

Answer 5

SafeArrayCreateVector

另一个选项是在其他答案中提到的^{1 2 3}，使用 SafeArrayCreateVector。虽然 SafeArrayCreate 返回指针（如 Erik A 所示），但这个函数直接返回数组。您需要为每种类型声明一个变量，例如：

 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的Same 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 returned
    
    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，您也可以使用用户定义的类型来实现此操作。只需像其他 API 调用一样添加另一个即可。更多讨论请参见 here。
• 如果有人想要具有多个维度的空值，则可以使用另一种有趣的方法，使用 SafeArrayCreate here。

- Mark E.

Answer 6

看起来很像如何创建一个可用于循环的分配但长度为零的数组？

Dim lStringArr As String() = {}

创建一个长度为0的数组，而不是空。

- Johann Wiengold