VBA

【VBA】配列に要素を任意の場所に追加する関数。(コピペOK)

  • 基本的に配列に要素を追加する標準の関数、メソッドはありません。
  • 要素を追加できる関数を作りました。コピペOKです。
  • 末尾だろうが、先頭だろうが、そのあいだだろうが、
    任意の場所に追加できます。

こんにちは、hokkyokunです。

VBAでは配列に要素を追加するには
要素の再宣言をする必要があります。

控えめに言ってもとても面倒なので、関数を作りました。
コピペOKです。

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

https://coconala.com/users/2030391

末尾に要素を追加する方法

コード(コピペOK)

まずはオーソドックスな配列の末尾に追加する関数です。

Function add_Elm(arrs As Variant, elm As Variant)
    Dim arr, results As Variant
    Dim i As Long
    
    'Is_exist_array関数で配列が空かどうか判定
    '詳しくはブログ見てね!
    If Not Is_exist_array(arrs) Then
        ReDim arrs(0)
        arrs(0) = elm
        add_Elm = arrs
        Exit Function
    End If
    
    'arrsより一つ大きな要素の配列を新たに作ってそこに格納する
    ReDim results(UBound(arrs) + 1)
    For Each arr In arrs
        results(i) = arr
        i = i + 1
    Next
    results(i) = elm
    add_Elm = results

End Function
  • 5~12行目
    配列が空の状態(そのまま処理を進めるとエラーで止まる状態)どうかを判定して
    空の場合は0番目に要素を追加します。
  • 14行目以降
    要素を末尾に追加する処理です。
    引数の配列より一つ大きな要素を持つ配列を作り、
    そこに格納、最後に要素を追加します。

例外処理(配列が空の状態やEmpty値がある状態)
を回避するために冗長になっています。

基本的に配列が空の状態やEmpty値を放置した使い方はエラーの元ですので
できるだけ発生させないプログラムが良いと思います。
発生させないルールを堅持するなら前半部分は不要です。

判定の関数は詳しくはブログを書いているので
よければ、そちらを見てください。

ちなみに判定のコードはこんな感じです。

'配列が空かどうか
'配列がすべてEmpty値であってもTrueとなります。
'ここでは、エラーを回避するために、配列の宣言が不十分な状態を回避することを目的とします。
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

'エラーが出ない状態でも配列の要素すべてEmpty値はありえます。
'すべての要素がEmpty値の場合を判定します。
Function Is_empty_array(arrs As Variant)
    Dim arr As Variant
    
    'ここでは配列の宣言が不十分な状態を配列が定義されていないと表現します。
    If Not Is_exist_array(arrs) Then
        MsgBox ("配列が定義されていません")
        Is_empty_array = False
        Exit Function
    End If
    
    For Each arr In arrs
        If TypeName(arr) = "Empty" Then
            Is_empty_array = True
            Exit Function
        End If
    Next
End Function

実際に使ってみます

では、実際に使ってみます。

Sub test_add_elm()
    Dim arrs As Variant
    arrs = Array(1, 2, 3, 4, 5, 6)
    arrs = add_Elm(arrs, 7)
    Stop
End Sub

こんな感じで、末尾に入れることができました。

要素を任意の場所に追加する方法

コード(コピペOK)

末尾に追加するだけでも実用的ですが、
場所を指定して入れたい場合や先頭に入れたい場合もあると思います。
そんな時はこちらを使ってみてください。

Function add_Elm_order(ByVal arrs As Variant, ByVal elm As Variant, ByVal order As Long)
    Dim i As Long
    Dim results() As Variant
    Dim arr As Variant
    
    'Is_exist_array関数で配列が空かどうか判定
    If Not Is_exist_array(arrs) Then
        ReDim results(0)
        results(0) = elm
        add_Elm_order = results
        Exit Function
    End If
    
    'orderが-1またはorderがarrsの最大インデックスより大きい場合
    '末尾に入れる
    If order = -1 Or order >= UBound(arrs) + 1 Then
        ReDim Preserve arrs(UBound(arrs) + 1)
        arrs(UBound(arrs)) = elm
        add_Elm_order = arrs
        Exit Function
    End If
    
    ReDim results(UBound(arrs) + 1)
    For Each arr In arrs
        If i <> order Then
            results(i) = arr
        Else
            results(i) = elm
            i = i + 1
            results(i) = arr
        End If
        i = i + 1
    Next
    add_Elm_order = results
End Function

実際に使ってみます

実際に使ってみます。
想定するパターンが多いので、まとめて書かせていただきました。
Pythonぽく末尾は-1で指定できるようにしました。
位置の指定に失敗して末尾より大きな数値で指定した場合は
末尾になるように調整しました。

Sub test_add_elm2()
    Dim arrs As Variant
    arrs = Array(1, 2, 3, 4, 5, 6)
    
    '先頭
    arrs = add_Elm_order(arrs, 7, 0)
    '>> [7,1,2,3,4,5,6]
    
    '任意の場所(配列の先頭と末尾の間)
    '最初は0番目であることに注意
    '3を指定した場合、0,1,2,3の4番目に追加することになる。
    arrs = add_Elm_order(arrs, 7, 3)
    '>> [1,2,3,7,4,5,6]
    
    '末尾は-1として指定
    arrs = add_Elm_order(arrs, 7, -1)
    '>> [1,2,3,4,5,6,7]
    
    '最大インデックスより上の数値で指定した場合
    '今回の場合は6以上
    arrs = add_Elm_order(arrs, 7, 15)
    '>> [1,2,3,4,5,6,7]
End Sub