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

Sub test_remove_array()

Dim arr As Variant
Dim arrs As Variant '元になる配列。ここから特定の要素を削除する
Dim results As Variant  '削除後の配列。これを求める。
Dim target As Variant  '特定の要素
Dim i As Long

'適当に配列を用意
arrs = Array("a", "b", "c", "d", "b")

'ターゲットとする要素
target = "b"


'配列の要素を一つずつ確認する。
'特定の要素が現れたらFor文を抜けて次の処理に向かう
'特定の要素が現れる前の要素は全てresultsに入れる
For Each arr In arrs
    If arr <> target Then
        If i = 0 Then
            ReDim results(i)
        Else
            ReDim Preserve results(i)
        End If
        results(i) = arr
        i = i + 1
        
    Else
        Exit For
    End If
Next

'targetを「ｂ」とした場合、i=1になっているはず
'つまり、arrsの「0」番目はresultsに格納している
'i+1=2番目以降のarrsの要素を問答無用でresultsに格納する
Do While i < UBound(arrs)
    If i = 0 Then
        ReDim results(i)
    Else
        ReDim Preserve results(i)
    End If
    
    results(i) = arrs(i + 1)
    i = i + 1
Loop


Dim msg As String
For Each arr In results
    msg = msg & arr & ","
Next
Debug.Print Left(msg, Len(msg) - 1)
'＞＞a,c,d,b
End Sub

Function remove_Elm(ByRef arrs As Variant, ByVal elm As Variant)
    Dim arr As Variant
    Dim results As Variant  '削除後の配列。これを求める。
    Dim i As Long
    
    '配列が空の場合は何もせずに終了
    If Not Is_correct_array(arrs) Then
        Exit Function
    End If
    
    '配列の要素を一つずつ確認する。
    '特定の要素が現れたらFor文を抜けて次の処理に向かう
    '特定の要素が現れる前の要素は全てresultsに入れる
    For Each arr In arrs
        If arr <> elm Then
            If i = 0 Then
                ReDim results(i)
            Else
                ReDim Preserve results(i)
            End If
            results(i) = arr
            i = i + 1
            
        Else
            Exit For
        End If
    Next
    
    '特定の要素が現れた位置プラス１以降の処理です。
    '問答無用でresultsに格納する
    Do While i < UBound(arrs)
        If i = 0 Then
            ReDim results(i)
        Else
            ReDim Preserve results(i)
        End If
        
        results(i) = arrs(i + 1)
        i = i + 1
    Loop
    
    'resultsの結果を元の配列に入れる
    '＝戻り値ではなく、引数が変更される
    '＝call remove_Elm()で使用する
    arrs = results
    
End Function

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

Sub test_Function_remove_Elm()
    Dim arrs As Variant
    
    arrs = Array("a", "b", "c", "d", "b", "b")
    Call remove_Elm(arrs, "b")
    
    'arrsの中身を確認
    Debug.Print Join(arrs, ",")
    '>>a,c,d,b,b
    
End Sub

Function remove_Elm_All(ByRef arrs As Variant, ByVal elm As Variant)

    Dim arr As Variant
    Dim results As Variant  '削除後の配列。これを求める。
    Dim i As Long
    
    '配列が空の場合処理せず終了する
    If Not Is_correct_array(arrs) Then
        Exit Function
    End If
    
    '特定の要素は格納せず、他の要素は全てresultsに入れる
    For Each arr In arrs
        If arr <> elm Then
            If i = 0 Then
                ReDim results(i)
            Else
                ReDim Preserve results(i)
            End If
            results(i) = arr
            i = i + 1
        End If
    Next
    arrs = results
    
End Function

Sub test_Function_remove_Elm_All()
    Dim arrs As Variant
    
    arrs = Array("a", "b", "c", "d", "b", "b")
    
    Call remove_Elm_All(arrs, "b")
    
    'arrsの中身を確認
    Debug.Print Join(arrs, ",")
    '>>a,c,d
End Sub