array push - 编写一个接受任何类型数组的 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() as String，我在推送函数中看到编译错误：Type mismatch: array or 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

我认为该函数现在可以接受任何类型的数组¹ 但它仍然返回一个Variant——我相信它不能分配给每个类型的数组（这意味着你会在某些情况下仍然会出现编译器错误）。

可能更简单的方法是将Function 更改为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" 推送到Long 类型的数组中——或者任何无法强制类型转换为数组类型的值。