配列

【VBA】配列の要素を値で削除する関数(コピペOK)

  • 配列の要素を値を指定して削除する関数です。
  • 例えば配列内にある「1」という値を削除したい。ということができます。
  • 全て削除する処理と
    一番最初に出てきた要素だけ消す処理の二通り対応できます。
  • コピペOKです。
  • 空配列の場合のエラー回避も考察してます。

配列の要素を自由自在に削除する関数を紹介したいと思います。

第二弾は要素の値を指定して削除する関数です。
例えば、「1」という値を指定して削除したいときはこちらの関数を使います。
配列内全部消すこともできます。

よろしくお願いいたします。

宣伝
ココナラでVBAマクロの作成代行を行っております。
興味がございましたら、よろしくお願いいたします。

https://coconala.com/users/2030391

コード

Function delete_Elm_from_value(arrs As Variant, elm As Variant, all_delete As Boolean)
    Dim results() As Variant
    Dim arr As Variant
    Dim i, j As Long
    Dim flg As Boolean
    
    For i = LBound(arrs) To UBound(arrs)
        '指定の要素すべて消すパターン
        If all_delete Then
            If arrs(i) <> elm Then
                ReDim Preserve results(j)
                results(j) = arrs(i)
                j = j + 1
            End If
            
        '指定の要素のうち、最初の要素のみ消すパターン
        Else
            '一回目は要素を除いて追加する
            '一回処理したらflgをTrueにして二回目以降はすべての要素を入れる
            If Not flg Then
                If arrs(i) <> elm Then
                    ReDim Preserve results(j)
                    results(j) = arrs(i)
                    j = j + 1
                Else
                    flg = True
                End If
                
            'flgがTrueなので要素は問答無用で入れる
            Else
                ReDim Preserve results(j)
                results(j) = arrs(i)
                j = j + 1
            End If
        End If
    Next

    delete_Elm_from_value = results
End Function

使い方

この関数は

要素の値を指定して、
その値を削除する関数ですが、

  • 配列から指定の値の要素を「全て」削除する
  • 配列から指定の値の要素を「最初の一つだけ」削除する

この二つを操作することができます。

delete_Elm_from_value(arrs As Variant, elm As Variant, all_delete As Boolean)
第一引数( arrs ) ⇒ 削除前配列
第二引数( elm ) ⇒ 削除する要素の値を指定
第三引数( all_delete) ⇒ 全て消すか、最初の一つだけ消すかブール型で指定
True : 全て False : 最初の一つだけ

実際に使ってみます。

例えば
配列が arrs = array ( 6 , 5 , 4 , 3 , 2 , 1 , 5 , 5 )のとき
delete_Elm_from_value(arrs, 5 , True)とすると、
「5」を全部消します。
結果は[6 , 4 , 3 , 2 , 1 ]

他にも色々と使ってみた結果を示します。

Dim arrs, arrs_str As Variant
Dim result As Variant
'数値の配列は
'arrs = Array(6, 5, 4, 5, 5)

'指定の値の要素全て削除
arrs = delete_Elm_from_value(arrs, 5, True)
'>> [6,4]

'指定の値の要素を最初の一つだけ削除
arrs = delete_Elm_from_value(arrs, 5, False)
'>> [6,4,5,5]

'要素の値が重複していない場合はどちらでも変わらない
'全部消すバージョン
arrs = delete_Elm_from_value(arrs, 4, True)
'>> [6,5,5,5]

'最初の一つだけ消すバージョン
arrs = delete_Elm_from_value(arrs, 4, True)
'>> [6,5,5,5]

'値がないものを指定しても何も起こらず配列を返す
arrs = delete_Elm_from_value(arrs, 3, True)
'>> [6,5,4,5,5]

'文字列でも大丈夫
arrs_str = Array("a", "b", "c", "D", "a", "aa", "a")
arrs_str = delete_Elm_from_value(arrs_str, "a", True)
'>> ["b","c","D","aa"]

arrs_str = delete_Elm_from_value(arrs_str, "a", False)
'>> ["b","c","D","a","aa","a"]

配列が空の場合の対応

配列が空の状態で処理をするとエラーを起こして、処理が止まる可能性があります。

空配列の判定をする関数を組み入れることで
エラーを回避させることができます。

空配列の判定関数として
is_exist_array関数を作りました。
詳細は下記の記事をご参照ください

こちらに空配列の判定コードを記載していますが、
どんなコードかというと、こんな感じです。

Function Is_exist_array(arrs As Variant)
    Dim a As Long
    On Error GoTo err
    a = UBound(arrs)
err:
    If err.Number = 9 Or err.Number = 13 Then
        Is_exist_array = False
    Else
        Is_exist_array = True
    End If
End Function

空配列対応のコード

空配列を間違って処理しても止まらないようにコードを改良した分です。
別途、Is_exist_array関数(空配列判定関数)をエディターに書く必要がありますが、
ある程度、配列の状態は気にしなくてよくなります。

Function delete_Elm_from_value(arrs As Variant, elm As Variant, all_delete As Boolean)
    Dim results() As Variant
    Dim arr As Variant
    Dim i, j As Long
    Dim flg As Boolean
    
    '配列が空かどうか
    If Not Is_exist_array(arrs) Then
        MsgBox ("配列が空です")
        delete_Elm_from_value = arrs
        Exit Function
    End If
    
    For i = LBound(arrs) To UBound(arrs)
        '指定の要素すべて消すパターン
        If all_delete Then
            If arrs(i) <> elm Then
                ReDim Preserve results(j)
                results(j) = arrs(i)
                j = j + 1
            End If
            
        '指定の要素のうち、最初の要素のみ消すパターン
        Else
            '一回目は要素を除いて追加する
            '一回処理したらflgをTrueにして二回目以降はすべての要素を入れる
            If Not flg Then
                If arrs(i) <> elm Then
                    ReDim Preserve results(j)
                    results(j) = arrs(i)
                    j = j + 1
                Else
                    flg = True
                End If
                
            'flgがTrueなので要素は問答無用で入れる
            Else
                ReDim Preserve results(j)
                results(j) = arrs(i)
                j = j + 1
            End If
        End If
    Next

    delete_Elm_from_value = results
End Function