程序员求职经验分享与学习资料整理平台

网站首页 > 文章精选 正文

VBA数组自定义删除元素方法

balukai 2025-03-06 12:08:39 文章精选 15 ℃
默认情况下,VBA没有很多针对数组的增删查改操作,需要我们自定义。
本文讲解如何用VBA写代码实现对数组的增删查改操作。
本文假定数组为不可变元素。针对数组的修改操作,都默认不修改原数组。

根据值删除元素

RemoveElement,删除特定元素的值。

'
' 从数组中删除元素
'
' @param arr Array,    数组
' @param value variant, 待查找元素
'
' @return Array
'
Function RemoveElement(ByVal arr As Variant, ByVal value As Variant) As Variant
    idx = IndexOf(arr, value)
    ' 元素不存在
    If idx = -1 Then
        RemoveElement = arr
        Exit Function
    End If
    '
    RemoveElement = RemoveElementAt(arr, idx)
End Function

测试用例:


Sub testRemoveElement()
    arr = Array(1, 3, 5)
    For i = LBound(arr) To UBound(arr)
        arr = Utils.RemoveElementAt(arr, 0)
    Next
End Sub

删除指定位置的元素

RemoveElementAt,删除指定下标位置的元素。-1表示最后一个元素。


'
' 从数组中删除元素
'
' @param arr Array,    数组
' @param idx long,      元素下标. idx=-1表示最后一个值,即idx=UBound(arr)
'
' @return Variant.      新的数组
'
Function RemoveElementAt(ByVal arr As Variant, ByVal idx As Long) As Variant
    ' idx=-1表示最后一个值,即idx=UBound(arr)
    idx = IIf(idx = -1, UBound(arr), idx)
    
    ' idx有效性判断
    If Not IsEmptyArray(arr) Then
        If Not (LBound(arr) >= idx And idx <= UBound(arr)) Then
            Err.Raise ERROR_INDEX_OVERFLOW
        End If
    ElseIf idx <> 0 Then ' 如果为空数组,idx必须等于0
        Err.Raise ERROR_INDEX_OVERFLOW
    End If
    
    ' 如果只有一个元素,直接返回
    If LBound(arr) = UBound(arr) Then
        RemoveElementAt = Array()
        Exit Function
    End If
    '
    Dim res()
    ReDim res(LBound(arr) To UBound(arr) - 1)
    ' 复制idx前面的元素
    For i = LBound(arr) To idx - 1
        res(i) = arr(i)
    Next
    ' idx开始,把后面的元素前移
    For i = idx To UBound(arr) - 1
        res(i) = arr(i + 1)
    Next
    
    RemoveElementAt = res
End Function

测试用例:

Sub testRemoveElementAt()
    arr2 = Array(1, 3, 5)
    For i = LBound(arr2) To UBound(arr2)
        arr2 = Utils.RemoveElement(arr2, arr2(0))
    Next
End Sub

最近发表
标签列表