根据索引从数组中删除元素（vba）

Question

我想要一个 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

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

Answer 1

如 cmets 中所述，我们需要在 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

Answer 2

感谢@Scott Craner，您的代码几乎是正确的，有了这个想法和您的帮助，我对其进行了如下修改并达到了预期的结果：

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

你有什么看法？更好，不是吗？