きっかけ#
職場の上司に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
結果
1 1
1 1
2 2
3 3
3 3
3 3
4 4
5 -
やりー！
二次元配列の壁#
試作もうまくいったし本番へ流用しよう！
ところが僕の頭では二次元配列のフィルタリングができない…
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