时间戳

首页 > 解决方案 > 根据索引从数组中删除一个元素（vba）

arrays - 根据索引从数组中删除一个元素（vba）

问题描述

我想要一个 vba 函数，它需要一个 2D（1 到 n，1 到 1）数组和一个索引，并从数组中删除一个元素（基于该索引）。我编码如下：

'this function removes an element of a 2D(1 to n,1 to 1) array based on the input index
Function RemoveElementFromArray(Arr1, Index As Long)
    Dim Arr2
    Dim i, ElmToRemoveIndex As Long
    Dim UB1, LB1, UB2, LB2 As Long
   
    ElmToRemoveIndex = Index
    LB1 = LBound(Arr1): UB1 = UBound(Arr1)
    LB2 = LB1: UB2 = UB1 - 1
    If ElmToRemoveIndex < LB1 Or ElmToRemoveIndex > UB1 Then
        MsgBox "The index is out of range!", vbExclamation
    ReDim Arr2(LB2 To UB2, 1 To 1)
    ElseIf ElmToRemoveIndex = LB1 Then
        For i = LB1 To i = UB2
           Arr2(i, 1) = Arr1(i + 1, 1)
        Next
    ElseIf ElmToRemoveIndex > LB1 And ElmToRemoveIndex < UB1 Then
        For i = LB1 To i = ElmToRemoveIndex - 1
           Arr2(i, 1) = Arr1(i, 1)
        Next
        For i = ElmToRemoveIndex To i = UB2
           Arr2(i, 1) = Arr1(i + 1, 1)
        Next
    ElseIf ElmToRemoveIndex = UB2 Then
        For i = LB1 To i = UB2
           Arr2(i, 1) = Arr1(i, 1)
        Next
    End If
    RemoveElementFromArray = Arr2
End Function

但是当我尝试在 sub 中使用它时遇到了运行时错误“13”：类型不匹配，而我希望打印“saeed”！

Sub test()
    Dim Arr1(1 To 5, 1 To 1)
    Dim Arr2
    Dim ElmToRemoveIndex As Long
    Arr1(1, 1) = "ali"
    Arr1(2, 1) = "reza"
    Arr1(3, 1) = "ahmad"
    Arr1(4, 1) = "saeed"
    Arr1(5, 1) = "shah"
    ElmToRemoveIndex = 3
    
    Arr2 = RemoveElementFromArray(Arr1, ElmToRemoveIndex)
    Debug.Print Arr2(3, 1)
End Sub

这段代码有什么问题？！如果可以，请你帮助我。

标签： arraysexcelvbafunction

解决方案

如评论中所述，我们需要在 IF 之外重新调整新数组。

多个 If 也可以用计数器替换：

Function RemoveElementFromArray(Arr1 As Variant, Index As Long)

    Dim UB1 As Long
    UB1 = UBound(Arr1, 1)
    
    Dim LB1 As Long
    LB1 = LBound(Arr1, 1)
    
    Dim Arr2() As Variant
    ReDim Arr2(LB1 To UB1 - 1, 1 To 1)
    
    If Index < LB1 Or Index > UB1 Then
        MsgBox "The index is out of range!", vbExclamation
    Else
        Dim k As Long
        k = LB1
        
        Dim i As Long
        For i = LB1 To UB1 - 1
            If i <> Index Then
                Arr2(k, 1) = Arr1(i, 1)
                k = k + 1
            End If
        Next i
    End If
    
    RemoveElementFromArray = Arr2
End Function

推荐阅读