【VBA】配列の位置を指定して要素を削除する関数（コピペですぐ使える）

Function Is_correct_array(ByVal arrs As Variant)
    Dim a As Long
    
    'なんでもいいが、エラーを生じさせる
    On Error GoTo err
    a = UBound(arrs)

    'エラーが生じたときエラー番号で9か13の場合はFalse
err:
    If err.Number = 9 Or err.Number = 13 Then
        Is_correct_array = False
    Else
        Is_correct_array = True
    End If
    
End Function

Function pop(ByRef arrs As Variant, ByVal loc As Long)
    Dim results() As Variant
    Dim i, j As Long
    
    ReDim Preserve results(j)
    '配列が空かどうか判定
    If Not Is_correct_array(arrs) Then
        MsgBox ("配列が空なので、pop関数は処理をせず、終了します。")
        Exit Function
    End If
    
    'locがマイナスのとき、後ろから位置を指定する
    '(例)loc=-1なら、最後尾、loc=-2なら後ろから二番目
    If loc < 0 Then
        loc = UBound(arrs) + 1 + loc
    End If
    
    'locの位置がarrsの要素数範囲外の場合処理をしない
    If loc > UBound(arrs) Or loc < LBound(arrs) Then
        MsgBox ("指定したインデックスが有効範囲にありません")
        Exit Function
    End If
    
    'locの位置の要素以外をresultsに格納
    For i = LBound(arrs) To UBound(arrs)
        If i <> loc Then
            ReDim Preserve results(j)
            results(j) = arrs(i)
            j = j + 1
        End If
    Next i
    
    arrs = results
End Function

Sub test_pop1()

Dim arrs As Variant
Dim loc As Long

arrs = Array("a", "b", "c", "d")

'先頭の位置を指定
loc = 0
Call pop(arrs, loc)

'中身を確認
Dim msg As String
Dim arr As Variant
For Each arr In arrs
    msg = msg & arr & ","
Next
Debug.Print Left(msg, Len(msg) - 1)
'＞＞b,c,d

End Sub

Sub test_pop2()

Dim arrs As Variant
Dim loc As Long

arrs = Array("a", "b", "c", "d")

'先頭の位置を指定
loc = 2
Call pop(arrs, loc)

'中身を確認
Dim msg As String
Dim arr As Variant
For Each arr In arrs
    msg = msg & arr & ","
Next
Debug.Print Left(msg, Len(msg) - 1)
'＞＞a,b,d

End Sub

Sub test_pop3()

Dim arrs As Variant
Dim loc As Long

arrs = Array("a", "b", "c", "d")

'先頭の位置を指定
loc = 3
Call pop(arrs, loc)

'中身を確認
Dim msg As String
Dim arr As Variant
For Each arr In arrs
    msg = msg & arr & ","
Next
Debug.Print Left(msg, Len(msg) - 1)
'＞＞a,b,c

End Sub

Sub test_pop4()

Dim arrs As Variant
Dim loc As Long

arrs = Array("a", "b", "c", "d")

'先頭の位置を指定
loc = -1
Call pop(arrs, loc)

'中身を確認
Dim msg As String
Dim arr As Variant
For Each arr In arrs
    msg = msg & arr & ","
Next
Debug.Print Left(msg, Len(msg) - 1)
'＞＞a,b,c

End Sub

Sub test_pop5()

Dim arrs As Variant
Dim loc As Long

arrs = Array("a", "b", "c", "d")

'先頭の位置を指定
loc = 4
Call pop(arrs, loc)

'中身を確認
Dim msg As String
Dim arr As Variant
For Each arr In arrs
    msg = msg & arr & ","
Next
Debug.Print Left(msg, Len(msg) - 1)
'＞＞指定したインデックスが有効範囲にないため、処理をしないで終了
'＞＞a,b,c,d

End Sub