きっかけ#

職場の上司にExcel VBAを使ってxmlから資材の一覧を作ってと言われた

ちょ、VBA初心者なんですけど#

VBAはなぜか肌に合わない感覚
他の言語とは違う空気があるような気がしています（今も）
しかも触れたことのないxmlからと…
そのうえフォーマットが違う3種類のxmlから纏めてね！とな

大分類のフォーマット1種類
小分類のフォーマット2種類

初心者ながらフォーマットから必要なデータはなんとか吸い出せた
ここは本題じゃないので省略

立ちはだかるテーブルたち#

大分類のテーブルと小分類のテーブルが出来上がりました
今度はこのテーブルを結合して大きな一覧を作る事に
少々かじったことのあるSQLの結合に似た左外部結合？
図を用意するのが面倒なので略

とりあえず試作#

二つの一次元配列を用意して結合してみた
無作法ですが急造なためお許しを

Sub TEST()

main_ary = Array(1, 1, 2, 3, 3, 3, 4, 5)
sub_ary = Array(1, 2, 3, 4)

i = 1

Worksheets(1).Select

For Each n In main_ary

    fil = Filter(sub_ary, n)

    If UBound(fil) = -1 Then
        
        Cells(i, 1) = n
        Cells(i, 2) = "-"
        i = i + 1
        
    Else
    
        For Each m In fil
            
            Cells(i, 1) = n
            Cells(i, 2) = m
            i = i + 1
            
        Next m
    
    End If

Next n

End Sub

結果

やりー！

二次元配列の壁#

試作もうまくいったし本番へ流用しよう！
ところが僕の頭では二次元配列のフィルタリングができない…

fil = Filter(sub_ary, n)

↑コレが使えない

ネットで検索してもいい感じのアルゴリズムが紹介されていない

ということで自作へ#

ポイントとして
1.調べたい配列の中に何個該当するものがあるのか
2.それをどう回収するか
の二点に絞って考えてみました

1.調べたい配列の中に何個該当するものがあるのか###

VBAの面倒なところは事前に配列長を指定しなければいけないところ
そこで下記の関数を作成してみた
該当するものがあればその必要な配列長を返し
該当するものがなければ-1を返します

Function hit_cnt(ByVal x As Variant, ByVal ary As Variant, ByVal idx As Long) As Long

cnt = 0

For Each n In ary
    If n(idx) = x Then
        cnt = cnt + 1
    End If
Next n

hit_cnt = cnt - 1

End Function

2.それをどう回収するか###

カウントする関数はできましたが今度はどうやって回収するのかに頭を悩ませました
何とかひねり出した関数が下記になります
渡した個数により配列長を決めます
-1の場合は「該当なし」を返します

Function hit_items(ByVal x As Variant, ByVal ary As Variant, ByVal idx As Long, ByVal hit As Long) As Variant()

If hit >= 0 Then

    ReDim return_val(hit)
    
    i = 0
    For Each n In ary
        If n(idx) = x Then
            return_val(i) = n
            i = i + 1
        End If
    Next n

Else

    ReDim return_val(0)
    return_val(0) = Array("-", "該当なし")

End If

hit_items = return_val

End Function

なんとか完成へ#

試行錯誤の末出来上がったのが下記になります
出来上がってみると案外簡素でした
これって左外部になるのでしょうか
SQL詳しくないのでごめんなさい

Sub TEST()

main_ary = Array(Array("aaa", "1"), Array("bbb", "1"), Array("ccc", "2"), Array("ddd", "2"), Array("zzz", "5"))
sub_ary = Array(Array("1", "あ"), Array("2", "い"), Array("3", "う"), Array("4", "え"))

i = 1

Worksheets("Sheet1").Select

For Each n In main_ary

    hit = hit_cnt(n(1), sub_ary, 0)
    items = hit_items(n(1), sub_ary, 0, hit)
    
    For Each m In items
    
        Cells(i, 1) = n(0)
        Cells(i, 2) = n(1)
        Cells(i, 3) = m(0)
        Cells(i, 4) = m(1)
        i = i + 1

    Next m
    
Next n

End Sub

Function hit_cnt(ByVal x As Variant, ByVal ary As Variant, ByVal idx As Long) As Long

cnt = 0

For Each n In ary
    If n(idx) = x Then
        cnt = cnt + 1
    End If
Next n

hit_cnt = cnt - 1

End Function

Function hit_items(ByVal x As Variant, ByVal ary As Variant, ByVal idx As Long, ByVal hit As Long) As Variant()

If hit >= 0 Then

    ReDim return_val(hit)
    
    i = 0
    For Each n In ary
        If n(idx) = x Then
            return_val(i) = n
            i = i + 1
        End If
    Next n

Else

    ReDim return_val(0)
    return_val(0) = Array("-", "該当なし")

End If

hit_items = return_val

End Function

結果

aaa	1	1	あ
bbb	1	1	あ
ccc	2	2	い
ddd	2	2	い
zzz	5	-	該当なし

うぇーい！
なんとか希望通りに出来上がりました

最後に#

ひとこと「疲れました」と言いたいです
もっと良い方法が思いついたら訂正します（多分しません）

戯言###

職場のネット環境がもっと良ければなぁ
家で内職しないで済むかもしれません
でも家のほうがモチベーション下がらないから家のほうがいいかも
リモートワーク推進派です

改訂版#

寝て起きたら思いついた改訂版になります
1.調べたい配列の中に何個該当するものがあるのか
が2に統合されてます
以下ソース

Sub TEST()

main_ary = Array(Array("aaa", "1"), Array("bbb", "1"), Array("ccc", "2"), Array("ddd", "2"), Array("zzz", "5"))
sub_ary = Array(Array("1", "あ"), Array("2", "い"), Array("2", "か"), Array("3", "う"), Array("4", "え"))

i = 1

Worksheets("Sheet1").Select

For Each n In main_ary

    items = hit_items(n(1), sub_ary, 0)
    
    For Each m In items
    
        Cells(i, 1) = n(0)
        Cells(i, 2) = n(1)
        Cells(i, 3) = m(0)
        Cells(i, 4) = m(1)
        i = i + 1
    Next m
    
Next n

End Sub

Function hit_items(ByVal x As Variant, ByVal ary As Variant, ByVal idx As Long) As Variant()

Dim hit_cnt As Long
hit_cnt = -1

ReDim return_val(0)

i = 0
For Each n In ary
    If n(idx) = x Then
        ReDim Preserve return_val(i)
        return_val(i) = n
        i = i + 1
        hit_cnt = hit_cnt + 1
    End If
Next n

If hit_cnt = -1 Then
    return_val(0) = Array("-", "該当なし")
End If

hit_items = return_val

End Function

結果

aaa	1	1	あ
bbb	1	1	あ
ccc	2	2	い
ccc	2	2	か
ddd	2	2	い
ddd	2	2	か
zzz	5	-	該当なし

戯言2###

宣言しないと代入できない-1とか意味が分からないんですけど

更に改訂#

カウントアップしてた変数iを削除しヒット数をカウントする変数hit_cntのカウントアップ場所を変更してみました

Function hit_items(ByVal x As Variant, ByVal ary As Variant, ByVal idx As Long) As Variant()

Dim hit_cnt As Long
hit_cnt = -1

ReDim return_val(0)

For Each n In ary

    If n(idx) = x Then
    
        hit_cnt = hit_cnt + 1
        ReDim Preserve return_val(hit_cnt)
        return_val(hit_cnt) = n

    End If
    
Next n

If hit_cnt = -1 Then

    return_val(0) = Array("-", "該当なし")
    
End If

hit_items = return_val

End Function