VBA！！配列の結合とプロシージャへの引数渡しのジレンマ！！【🚨番外編：Filter関数による重複排除を行った結合配列の作成】

Last updated at 2024-01-24Posted at 2024-01-21

課題設定

配列要素の重複を削除するSubプロシージャに引数として配列を渡そうとしたのだが、
配列を結合したものをプロシージャの引数に受け取らせようとした場合、
これが一筋縄にはいかない・・・
VBAは宣言した時の型、特に配列の場合ですが、その後の動作に深く関わります。
ちょっと話題の本筋から逸れますが、そもそも、

Dim arr()

とした場合、VBAは動作の挙動としては動的型付けをしてくれないんですね！

今回想定するのは、あるテーブルとあるテーブルの共通カラムについて、データを結合して集約した上、その中の要素の重複を排するケースで必要になります。
例えば、具体的なイメージとしては、科目A『国語』と科目B『英語』の受験者の受験番号(それぞれarr1,arr2)を集約して、最終的には中の要素が重複することなく一つの配列sorted_arr3を作ることをイメージします。
※それまでの過程でarr3/super_arr3が登場します。
[sorted_arr3完成形イメージ]

sorted_arr3 = ["0001","0002","0004","0005","0006,"0007","0009","0010","0011","0012"]

配列の要素の重複を排する処理については、他の記事にDictionaryを用いた完成形が既にございますので、割愛させて頂きます！！
【参照】VBAで配列から重複する値を順序を変えずに削除する
本記事では、そこに至る繋ぎとしてどうしても必要になるワザの部分を主眼とします。

多くの試行錯誤を要しました。

そして、ネット上に今のところ記事が無く、明確に解が見えてきたので、それを備忘録としても後学の為にも記録にしようと思った次第です。
どうぞお付き合いください。

最初にお伝えしておきますが、結合されて作られた配列は文字型とします。

①プロシージャの引数に配列を入れよう！！

さて、そもそも、プロシージャの引数に配列を入れたければ、
定義する際、()を付けておかないといけません。

❌

Dim arr As Variant

⭕

Dim arr() As Variant

そして、プロシージャで呼び出す際には、次のようにすることができます！！

Call procedure(arr)

⚠️【注記】⚠️
配列を引数に渡す時には、()を付けるのが定石のようです！！
Call procedure(arr())
Sub procedure(arr())

End Sub
ただし、Variant型で作成された配列などは、変数扱いされるので、()が要らないという挙動を示しています！！

ここまでは、調べれば出てくる、鉄板と言えるでしょう！！・・・

②配列を結合するには・・・

はい、これも定型文としてネット上で記事に上がっておりますので、鉄板になると思うのですが、配列を結合する腹積もりであるなら、配列を次のように宣言しておく必要があります。
配列arr1と配列arr2を結合して、配列arr3を作るという試みを前提とします。

Dim arr1() As Variant, arr2() As Variant, arr3 As Variant

そうしないと、Split/Joinを利用して、arr1とarr2を連結してarr3に格納しようとした時に、「型が一致しません」のエラーが出てしまいます。
arr3の後ろに、決してVariant型で()を付けてはいけないんですね！

③さて、どうしたものか・・・

ここまで見て来て、お気づきになられたかもしれませんが、
結合で作られた配列arr3をプロシージャの引数に取り入れたいとなったら、ジレンマに陥ることになります。😱😱😱
①では()付き、一方②では()無しによる宣言を推奨している。
arr3をターゲットとして並べてみます。

①プロシージャの引数に取る為に・・・

Dim arr3() As Variant

②配列の結合を来す為に・・・

Dim arr1() As Variant, arr2() As Variant, arr3 As Variant

分かり易くなっただろうか・・・
じゃあ、どうすれば良いのか？・・・

この記事の肝はここである。

今回上手く行った方法として、次のような形式で配列を宣言するというものが分かってきました。
最初にお伝えしましたが、結合されて作られた配列は文字型という想定です。

Dim arr1() As Variant, arr2() As Variant, arr3() As String

こうすると、プロシージャの引数にも格納出来、本来の前提である、結合された配列として、arr3を扱うことができるんですね。。。

尚、本件の場合、①プロシージャの引数に配列を入れよう！！で見たように、procedureのcallは次のように実施します！！

Call procedure(arr)

⚠️【注記】⚠️
配列を引数に渡す時には、()を付けるのが定石のようです！！
Call procedure(arr())
Sub procedure(arr())

End Sub
ただし、Variant型で作成された配列などは、変数扱いされるので、()が要らないという挙動を示しています！！

callされるprocedureは次のように引数の型を宣言しておく必要があります！！

Sub procedure(arg_arr() As String)
' 重複を削除するソース
End Sub

冒頭でお話したように、配列の要素の重複を排する処理については、他の記事にDictionaryを用いた完成形が既にございますので、割愛させて頂きます！！
【参照】VBAで配列から重複する値を順序を変えずに削除する
あ、そうそう、VBAのDictionaryを活用する際には、次の設定が必要になりますので、お忘れなく・・・

🎉完成版🎉[結果とソースコード]

完成の結果

ソースコード

Public super_arr3() As Variant
'Public super_arr3() As String　' ←◆super_arr3 = arEditでエラー！！◆
Sub main()
    Dim ex_num As Integer, in_num As Integer
    Dim count As Integer
    Dim A_lastrow As Integer, B_lastrow As Integer
    Dim List_Sheet As Worksheet
    Dim arr1() As Variant, arr2() As Variant, arr3() As String, sorted_arr3() As Variant    '←◆"sorted_arr3"でもOK！！型はStringにするとError！！◆
    Set List_Sheet = ThisWorkbook.Worksheets("リスト")
    
    A_lastrow = List_Sheet.Cells(Rows.count, 2).End(xlUp).Row
    B_lastrow = List_Sheet.Cells(Rows.count, 5).End(xlUp).Row
    
    'arr1 = List_Sheet.Range(Cells(4, 2), Cells(A_lastrow, 2))  '■本件においては取り扱わない
    'arr2 = List_Sheet.Range(Cells(4, 5), Cells(B_lastrow, 5))  '■本件においては取り扱わない
    
    '==================================================================
    'arr1を作成！！
    '==================================================================
    ReDim arr1(0)
    count = 0
    
    For ex_num = 4 To A_lastrow
        If count = 0 Then
            arr1(0) = List_Sheet.Cells(ex_num, 2)
        Else
            ReDim Preserve arr1(count)
            arr1(count) = List_Sheet.Cells(ex_num, 2)
        End If
        count = count + 1
    Next
    
    '==================================================================
    'arr2を作成！！
    '==================================================================
    ReDim arr2(0)
    count = 0
    For ex_num = 4 To A_lastrow
        If count = 0 Then
            arr2(0) = List_Sheet.Cells(ex_num, 5)
        Else
            ReDim Preserve arr2(count)
            arr2(count) = List_Sheet.Cells(ex_num, 5)
        End If
        count = count + 1
    Next
    arr3() = Split(Join(arr1, vbCrLf) & vbCrLf & Join(arr2, vbCrLf), vbCrLf)
    
    
    '==================================================================
    'arr3を転写！！
    '==================================================================
    For ex_num = 0 To UBound(arr3)                                  '※LBound(arr3) = 1
        List_Sheet.Cells(ex_num + 4, 8).NumberFormatLocal = "@"
        List_Sheet.Cells(ex_num + 4, 8) = arr3(ex_num)
    Next
    
    Stop
    Call DeleteSameValue(arr3)             '←◆Call DeleteSameValue(arr3())でもOK!◆
    Stop
    '==================================================================
    'super_arr3を転写！！
    '==================================================================
    For ex_num = 0 To UBound(super_arr3)                            '※LBound(super_arr3) = 0
        List_Sheet.Cells(ex_num + 4, 10).NumberFormatLocal = "@"
        List_Sheet.Cells(ex_num + 4, 10) = super_arr3(ex_num)
    Next
    
    '==================================================================
    '◆◆◆super_arr3をソート！！◆◆◆
    '==================================================================
    sorted_arr3 = WorksheetFunction.Sort(super_arr3, 1, 1, True)
    '==================================================================
    'sorted_arr3を転写！！
    '==================================================================
    For ex_num = 1 To UBound(sorted_arr3)                            '※LBound(sorted_arr3) = 1
        List_Sheet.Cells(ex_num + 3, 12).NumberFormatLocal = "@"
        List_Sheet.Cells(ex_num + 3, 12) = sorted_arr3(ex_num)
    Next
End Sub

Sub DeleteSameValue(arg_arr() As String)
    Dim dic As New Dictionary   '// 重複を除いた値を格納するDictionary
    Dim i                       '// ループカウンタ１
    Dim ii                      '// ループカウンタ２
    Dim iLen                    '// 配列要素数
    Dim arEdit()                '// 編集後の配列
    
    ReDim arEdit(0)
    iLen = UBound(arg_arr)
    
    '// 配列ループ
    For i = 0 To iLen
        '// 配列に未登録の値の場合
        If (dic.Exists(arg_arr(i)) = False) Then
            '// Dictionaryに追加
            Call dic.Add(arg_arr(i), arg_arr(i))
            
            '// 重複がない値のみを編集後配列に格納する
            arEdit(UBound(arEdit)) = arg_arr(i)
            ReDim Preserve arEdit(UBound(arEdit) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If (IsEmpty(arEdit(0)) = False) Then
        '// 余分な領域を削除
        ReDim Preserve arEdit(UBound(arEdit) - 1)
    End If
    Stop
    '// 引数に編集後配列を設定
    super_arr3 = arEdit                 '←◆super_arr3()/arEdit()どちらでもOK!◆
End Sub

これで、あるテーブルとあるテーブルの共通カラムについて、データを結合して集約した上、その中の要素の重複を排することができるように繋ぐことができました！！

勿論、procedureではなく、functionで実装する方法もあるかとは思います！！

何かご指摘ございましたら、頂けますと幸いです！！

🚨番外編　Filter関数による重複排除を行った結合配列の作成

或いは、【参照】VBAで配列から重複する値を順序を変えずに削除する
から離れて、Filter関数を使って、「片方の配列arr2に値があれば、作成する配列（例えばsuper_arr3()）にarr1の要素を入れないでおき、後は、arr1とarr2の要素をsuper_arr3()に入れる」なんて処理もありかも！！なんて思いつきました！！sorted_arr3の出力結果は同じです！！
完成の結果

ソースコード

Public super_arr3() As Variant
'Public super_arr3() As String　' ←◆super_arr3 = arEditでエラー！！◆
Sub main()
    Dim ex_num As Integer, in_num As Integer
    Dim count As Integer
    Dim A_lastrow As Integer, B_lastrow As Integer
    Dim List_Sheet As Worksheet
    Dim arr1() As Variant, arr2() As Variant, arr3() As String, sorted_arr3() As Variant    '←◆"sorted_arr3"でもOK！！型はStringにするとError！！◆
    Dim Rtn_Filter As Variant
    Set List_Sheet = ThisWorkbook.Worksheets("リスト")
    
    A_lastrow = List_Sheet.Cells(Rows.count, 2).End(xlUp).Row
    B_lastrow = List_Sheet.Cells(Rows.count, 5).End(xlUp).Row
    
    'arr1 = List_Sheet.Range(Cells(4, 2), Cells(A_lastrow, 2))  '■本件については取り扱わない
    'arr2 = List_Sheet.Range(Cells(4, 5), Cells(B_lastrow, 5))  '■本件については取り扱わない
    
    '==================================================================
    'arr1を作成！！
    '==================================================================
    ReDim arr1(0)
    count = 0
    
    For ex_num = 4 To A_lastrow
        If count = 0 Then
            arr1(0) = List_Sheet.Cells(ex_num, 2)
        Else
            ReDim Preserve arr1(count)
            arr1(count) = List_Sheet.Cells(ex_num, 2)
        End If
        count = count + 1
    Next
    
    '==================================================================
    'arr2を作成！！
    '==================================================================
    ReDim arr2(0)
    count = 0
    For ex_num = 4 To A_lastrow
        If count = 0 Then
            arr2(0) = List_Sheet.Cells(ex_num, 5)
        Else
            ReDim Preserve arr2(count)
            arr2(count) = List_Sheet.Cells(ex_num, 5)
        End If
        count = count + 1
    Next
    arr3() = Split(Join(arr1, vbCrLf) & vbCrLf & Join(arr2, vbCrLf), vbCrLf)
    
    
    '==================================================================
    'arr3を転写！！
    '==================================================================
    For ex_num = 0 To UBound(arr3)                                  '※LBound(arr3) = 1
        List_Sheet.Cells(ex_num + 4, 8).NumberFormatLocal = "@"
        List_Sheet.Cells(ex_num + 4, 8) = arr3(ex_num)
    Next
    
    Stop
'    Call DeleteSameValue(arr3)             '←◆Call DeleteSameValue(arr3())でもOK!◆

    
    '==================================================================
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
    '🚨Filter関数を用いて、super_arr3を作成！！
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
    '==================================================================
    ReDim super_arr3(0)
    count = 0
    For ex_num = LBound(arr1) To UBound(arr1)
        Rtn_Filter = Filter(arr2, arr1(ex_num))
        If (UBound(Rtn_Filter) <> -1) Then
            ' DO NOTHING
        Else
            If count = 0 Then
                super_arr3(0) = arr1(ex_num)
            Else
                ReDim Preserve super_arr3(count)
                super_arr3(count) = arr1(ex_num)
            End If
            count = count + 1
        End If
    Next
    
    For ex_num = LBound(arr2) To UBound(arr2)
        ReDim Preserve super_arr3(count)
        super_arr3(count) = arr2(ex_num)
        count = count + 1
    Next
    


    Stop
    '==================================================================
    'super_arr3を転写！！
    '==================================================================
    For ex_num = 0 To UBound(super_arr3)                            '※LBound(super_arr3) = 0
        List_Sheet.Cells(ex_num + 4, 10).NumberFormatLocal = "@"
        List_Sheet.Cells(ex_num + 4, 10) = super_arr3(ex_num)
    Next
    
    '==================================================================
    '◆◆◆super_arr3をソート！！◆◆◆
    '==================================================================
    sorted_arr3 = WorksheetFunction.Sort(super_arr3, 1, 1, True)
    '==================================================================
    'sorted_arr3を転写！！
    '==================================================================
    For ex_num = 1 To UBound(sorted_arr3)                            '※LBound(sorted_arr3) = 1
        List_Sheet.Cells(ex_num + 3, 12).NumberFormatLocal = "@"
        List_Sheet.Cells(ex_num + 3, 12) = sorted_arr3(ex_num)
    Next
End Sub

🫂総まとめ

現状、VBAで何かマクロを組んでデータ処理を行うに際しては、
【1】Filter関数の活用
【2】配列の要素数を動的に変えながら要素追加（"ReDim"の活用）
【3】重複の排除を通したDictionaryの活用
【4】procedureやfunctionの引数を用いた活用
この辺りの活用が柱となり、超重要になってくるという経験談です😊！！
他、ピボットテーブルを作るだとか、グラフを描画するだとかはあるかもしれませんが、
本稿では、【1】~【4】までfunctionを除いて、万遍なく、一通り、触れられたかと思います！！

この知見がお役に立ちますと幸いです！！
現場からは、以上です。🙆‍♂️

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up