VBA

【VBA】配列の要素を順番を指定して削除する関数(コピペOK)

  • 配列の要素を順番を指定して削除できます。
  • 〇〇番目の要素を指定して削除します。
  • 配列が空でも止まらず処理できます(別途関数必要)。
  • コピペOKです。

こんにちは、hokkyokunです。

配列の要素を自由自在に削除したいと思います。
第一弾として要素を順番を指定して削除する関数を作りました。
コピペOKです。

ココナラでVBAマクロの作成を代行できます。
ご興味ございましたら、こちらからよろしくお願いいたします。

https://coconala.com/users/2030391

配列が空の場合の対応

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

そこで、空配列の対応をするかどうかで
2種類のコード用意しました。

  1. 配列の状態を鑑み、空配列の対応をする関数
    1. コードが長い
    2. Is_exist_array関数(詳細は下記)が必要
    3. 配列の状態をある程度考えなくて使える
  2. 配列の状態を考えない、短いコードの関数
    1. コードが短い
    2. 基本的にこのコードで完結する
    3. 配列の状態に配慮する必要がある

空配列が発生しないように管理できるのであれば、
1.のコードで十分です。

空配列を判定するIs_exist_array関数について
詳しくは、こちらの記事をご覧ください。

コード

空配列処理対応のコードと空配列処理を考えないコードの二つです。

空配列処理対応のコード

上記でも書きましたが、
配列の状態を確認するIs_exist_array関数が必要です。
その分、配列の状態をある程度気にせず使用できます

'配列を順番を指定して削除する
Function delete_Elm_order(arrs As Variant, order As Variant)
    Dim results() As Variant
    Dim i, j As Long
    
    '配列が空かどうか
    If Not Is_exist_array(arrs) Then
        MsgBox ("配列が空です")
        delete_Elm_order = arrs
        Exit Function
    End If
    
    '末尾処理
    'orderが-1もしくは最大インデックス値以上の値を指定する場合
    If order = -1 Or order >= UBound(arrs) Then
        '要素が一つしかない場合は
        'その一つの要素を再宣言をしてEmpty値にする
        If UBound(arrs) = 0 Then
            ReDim arrs(0)
        Else
            '要素数を一つ少なくして再宣言すると末尾の要素が削除される
            ReDim Preserve arrs(UBound(arrs) - 1)
        End If
        delete_Elm_order = arrs
        Exit Function
    End If
    
    '末尾以外の処理
    '新たにresultsという配列を用意する
    'arrsをfor文で回してorderの番号以外の要素を格納する
    For i = LBound(arrs) To UBound(arrs)
        ReDim Preserve results(j)
        If i <> order Then
            results(j) = arrs(i)
            j = j + 1
        End If
    Next
    delete_Elm_order = results
End Function

空配列処理を考えないコード(短いコード)

この関数だけで、処理が完了します
ただし、配列は空の状態でないように運用をしてください

'配列を順番を指定して削除する
Function delete_Elm_order(arrs As Variant, order As Variant)
    Dim results() As Variant
    Dim i, j As Long
    
    '末尾処理
    'orderが-1もしくは最大インデックス値以上の値を指定する場合
    If order = -1 Or order >= UBound(arrs) Then
        '要素が一つしかない場合は
        'その一つの要素を再宣言をしてEmpty値にする
        If UBound(arrs) = 0 Then
            ReDim arrs(0)
        Else
            '要素数を一つ少なくして再宣言すると末尾の要素が削除される
            ReDim Preserve arrs(UBound(arrs) - 1)
        End If
        delete_Elm_order = arrs
        Exit Function
    End If
    
    '末尾以外の処理
    '新たにresultsという配列を用意する
    'arrsをfor文で回してorderの番号以外の要素を格納する
    For i = LBound(arrs) To UBound(arrs)
        ReDim Preserve results(j)
        If i <> order Then
            results(j) = arrs(i)
            j = j + 1
        End If
    Next
    delete_Elm_order = results
End Function

使い方

上記の関数の使い方です。
いずれも同様の使い方です。
引数と戻り値は以下の通りです。

delete_Elm_order(arrs As Variant, order As Variant)
引数:第一引数 arrs  ⇒ 削除する前の配列
   第二引数 orders ⇒ 削除する要素の順番
戻り値:配列

  • 第二引数の要素の順番は0からスタートすることに注意してください。
  • Pythonっぽく「-1」を指定すると末尾を指定することができます。
  • 最大インデックス数以上の数値(要素数よりも大きな数値)を指定した場合、
    自動的に末尾指定になります。

例えば
配列 arrs= array( 1 , 2 , 3 , 4 , 5 , 6 )のうち、
一番目の要素(ここでは1)を消す場合

delete_Elm_order( arrs , 0)とします。
結果は arrs = [ 2 , 3 , 4 , 5 , 6 ]となります。

使用例をまとめてみました。

Sub test_delete_elm()
    Dim arrs As Variant
    Dim result As Variant
    arrs = Array(1, 2, 3, 4, 5, 6)
    
    '先頭
    arrs = delete_Elm_order(arrs, 0)
    '>> [2,3,4,5,6]
    
    '任意の場所(配列の先頭と末尾の間)
    '最初は0番目であることに注意
    '3を指定した場合、0,1,2,3の4番目の要素を削除する。
    '今回の場合だと4
    arrs = delete_Elm_order(arrs, 3)
    '>> [1,2,3,5,6]

    '末尾は-1として指定
    arrs = delete_Elm_order(arrs, -1)
    '>> [1,2,3,4,5]
    
    '最大インデックス以上の数値で指定した場合
    '今回の場合は5以上
    arrs = delete_Elm_order(arrs, 6)
    '>> [1,2,3,4,5]

End Sub