数组推写接受任何类型数组的VBA函数

Question

我试图编写一个简单的push函数，它可以向VBA数组中添加元素。

我不知道如何允许它接受类型化数组。到目前为止，我可以得到函数来接受显式键入为“variant”的数组。见下文

Function push(arr() As Variant, el As Variant) As Variant()
    ' function to redim an array and increment it by one.  If array is length 1 and element is empty, it will place the "el" param in the first index
    If IsEmpty(arr(UBound(arr))) And UBound(arr) = LBound(arr) Then
        arr(UBound(arr)) = el
    Else
        ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
        arr(UBound(arr)) = el
    End If
    push = arr
End Function

Sub testPush()
    Dim myArr() As Variant
    Dim newArr() As Variant
    myArr = Array("apple", "banana", "4")
    myArr = push(myArr, "coconut")
    Debug.Print Join(myArr, ", ")
    newArr = Array(1, 2, 3, 4)
    newArr = push(newArr, 7)
    Debug.Print Join(newArr, ", ")
End Sub

当我将myArr维度为字符串时，例如dim myArr（）维度为string，我在推送函数中看到一个编译错误:type mismatch：array或user defined type expected。有没有什么方法可以使用一个函数来尝试将元素递增到数组的末尾，而不管数组的类型如何？

Answer 1

与我下面写的相反，也许比我更了解的人会告诉你这是可能的，以及你如何做到这一点。

我看到您的函数返回一个变量数组：

Function push(arr() As Variant, el As Variant) As Variant()

如果我理解正确的话，它只能分配给variant或variant()类型的变量。

如果我将函数更改为：

Function push(arr As Variant, el As Variant) As Variant

我认为该函数现在可以接受任意类型的数组¹，但它仍然返回变量--我认为不能将其分配给所有类型的数组（这意味着在某些情况下仍然会出现编译器错误）。

更简单的方法可能是将函数更改为sub并让子例程就地修改数组。这样，调用站点上就没有赋值（因为子程序不返回值），代码应该编译。这也意味着任何类型错误²现在都将在运行时发生。

此外，我不清楚下面的观点是什么：

If IsEmpty(arr(UBound(arr)))

您似乎在检查数组的第一个元素是否被分配了默认初始化值以外的其他内容。但是这种检查似乎只适用于variant类型（初始化为空）。我认为字符串初始化为“”，数字初始化为0，对象初始化为nothing，依此类推。简而言之，我认为isempty检查可能会对variant以外的类型返回假阴性。前面提到的行为可能是您想要的，也可能不是（假设您说您希望这个push代码处理任何类型的数组）。

总的来说，一种方法可以是这样的：

Option Explicit

Sub Push(ByRef someArray As Variant, ByVal someElement As Variant)
    ' This routine expects array to be 1-dimensional.
    ' and will modify the array in-place.
    ' The array must by dynamic (cannot Redim an array that
    ' was statically declared).

    Dim lastIndex As Long
    lastIndex = UBound(someArray)

    Dim arrayNeedsExtending As Boolean
    ' If you are using "IsEmpty" to work out if the first element
    ' has been assigned a value other than its default value at initialisation
    ' then you may need to see: https://stackoverflow.com/a/3331239/8811778
    ' as "IsEmpty" might only work for Variants and may return false
    ' negatives otherwise.
    arrayNeedsExtending = (lastIndex <> LBound(someArray)) Or Not IsEmpty(someArray(lastIndex))

    If arrayNeedsExtending Then
        ReDim Preserve someArray(LBound(someArray) To (lastIndex + 1))
    End If

    ' If you have an array of objects (hypothetically, instead of a collection), the line below
    ' will raise a syntax error since Set keyword is required for objects.
    someArray(UBound(someArray)) = someElement
End Sub

Private Sub TestPush()

    Dim someStrings() As String
    someStrings = Split("a,a", ",", -1, vbBinaryCompare)
    Push someStrings, "b"
    Debug.Assert (JoinArray(someStrings) = "a,a,b")

    Dim someBooleans() As Boolean ' Can only Push dynamic arrays
    ReDim someBooleans(0 To 1)
    Push someBooleans, True
    Debug.Assert (JoinArray(someBooleans) = "False,False,True")

    Dim someZeros() As Long
    ReDim someZeros(0 To 1)
    Push someZeros, 0
    Debug.Assert (JoinArray(someZeros) = "0,0,0")

End Sub

Private Function JoinArray(ByRef someArray As Variant, Optional delimiter As String = ",") As String
    ' Expects array to be 1-dimensional.
    ' Attempts to handle non-string types albeit without error handling.

    Dim toJoin() As String
    ReDim toJoin(LBound(someArray) To UBound(someArray))

    Dim arrayIndex As Long
    For arrayIndex = LBound(someArray) To UBound(someArray)
        toJoin(arrayIndex) = CStr(someArray(arrayIndex)) ' Will throw if type cannot be coerced into string.
    Next arrayIndex

    JoinArray = Join(toJoin, delimiter)
End Function

²假设您传递字符串“a”要推入长类型的数组--或者任何不能以类型强制进入数组类型的值。