キーと一致している連想配列の値を横に繋げて二次元配列にしたい

前提

１か月前からVBAを勉強し、仕事で使用をしています。
自分の至らなさにより、ここ数回こちらで質問させていただいております。今回も1日悩んで解決できず、悔しいのですが質問しました。

以前質問した内容と連動した質問となります。
https://teratail.com/questions/n9z6ktrk2v0403

実現したいこと

二次元配列の中に以下のように加工したデータを持ちたいです。

データが3つあります（実際にはデータ数は変動します）
また、本来は1つのファイルにデータが約10万件あります。
なので高速化できることが望ましいです。
また、カラム数やカラム名もその時々により変化します。

１ファイル目（wearデータ）

２ファイル目（oralデータ）

3ファイル目（gadgetデータ）

IDはユニークとなります。
この３つのデータをジョインし、二次元配列の中に以下のように加工したいです。
加工内容としてはFULL JOINにあたります。

データの持ち方

ユニークなIDのキーとして、以下の値の一次元配列を持っています。
[ "ID", "1", "2", "3", "4", "5", "6", "7"]

また、一次元配列arrsがあります。
arrsの中には、dict型のwear, oral gadgetがそれぞれ代入されています。
dict型のkeyは画像でいうところのA列になり、itemは["ID","性別","年齢"…]という感じで配列となっています。

以下の図をみていただければわかりやすいかもしれません。

データスクリプト

vba
1Dim keyArr(7) As Variant
2keyArr(0) = "ID"
3keyArr(1) = "1"
4keyArr(2) = "2"
5keyArr(3) = "3"
6keyArr(4) = "4"
7keyArr(5) = "5"
8keyArr(6) = "6"
9keyArr(7) = "7"
10
11
12Dim a(6) As Variant
13Dim b(6) As Variant
14Dim c(6) As Variant
15Dim d(6) As Variant
16Dim e(6) As Variant
17Dim f(6) As Variant
18Dim g(6) As Variant
19Dim h(6) As Variant
20Dim i(6) As Variant
21Dim j(5) As Variant
22Dim k(5) As Variant
23Dim l(5) As Variant
24Dim m(5) As Variant
25Dim n(5) As Variant
26Dim o(5) As Variant
27
28a(0) = "ID"
29a(1) = "性別"
30a(2) = "年齢"
31a(3) = "肌着"
32a(4) = "ニット"
33a(5) = "シャツ"
34a(6) = "帽子"
35
36b(0) = "1"
37b(1) = "男"
38b(2) = "20"
39b(3) = "1"
40b(4) = "0"
41b(5) = "2"
42b(6) = "1"
43
44c(0) = "2"
45c(1) = "女"
46c(2) = "21"
47c(3) = "1"
48c(4) = "2"
49c(5) = "0"
50c(6) = "1"
51
52d(0) = "3"
53d(1) = "女"
54d(2) = "19"
55d(3) = "1"
56d(4) = "1"
57d(5) = "1"
58d(6) = ""
59
60e(0) = "6"
61e(1) = "男"
62e(2) = "22"
63e(3) = "1"
64e(4) = "1"
65e(5) = "1"
66e(6) = "1"
67
68f(0) = "ID"
69f(1) = "性別"
70f(2) = "年齢"
71f(3) = "化粧水"
72f(4) = "乳液"
73f(5) = "歯ブラシ"
74f(6) = "整髪料"
75
76g(0) = "1"
77g(1) = "男"
78g(2) = "20"
79g(3) = "1"
80g(4) = "0"
81g(5) = "1"
82g(6) = "1"
83
84h(0) = "4"
85h(1) = "女"
86h(2) = "22"
87h(3) = "1"
88h(4) = "1"
89h(5) = "1"
90h(6) = "0"
91
92i(0) = "3"
93i(1) = "女"
94i(2) = "19"
95i(3) = "1"
96i(4) = "1"
97i(5) = "1"
98i(6) = "0"
99
100j(0) = "ID"
101j(1) = "性別"
102j(2) = "年齢"
103j(3) = "PC"
104j(4) = "スマホ"
105j(5) = "モバイルバッテリー"
106
107k(0) = "1"
108k(1) = "男"
109k(2) = "20"
110k(3) = "1"
111k(4) = "1"
112k(5) = "1"
113
114l(0) = "2"
115l(1) = "女"
116l(2) = "21"
117l(3) = "1"
118l(4) = "1"
119l(5) = "1"
120
121m(0) = "5"
122m(1) = "男"
123m(2) = "19"
124m(3) = "1"
125m(4) = "1"
126m(5) = ""
127
128n(0) = "6"
129n(1) = "男"
130n(2) = "22"
131n(3) = "1"
132n(4) = "1"
133n(5) = "1"
134
135o(0) = "7"
136o(1) = "女"
137o(2) = "20"
138o(3) = "1"
139o(4) = "1"
140o(5) = "1"
141
142
143
144
145Dim wear As Object
146Set wear = CreateObject("Scripting.Dictionary")
147wear.Add "1", a
148wear.Add "2", b
149wear.Add "3", c
150wear.Add "6", d
151
152Dim oral As Object
153Set oral = CreateObject("Scripting.Dictionary")
154oral.Add "1", e
155oral.Add "4", f
156oral.Add "3", g
157
158Dim gadget As Object
159Set gadget = CreateObject("Scripting.Dictionary")
160gadget.Add "1", h
161gadget.Add "2", i
162gadget.Add "5", j
163gadget.Add "6", k
164gadget.Add "7", l
165
166Dim arrs(2) As Variant
167Set arrs(0) = wear
168Set arrs(1) = oral
169Set arrs(2) = gadget
170

該当のソースコード

vba
1
2'    ジョインする為の土台となるテンプレート１列分だけ作成（ID)
3Dim keyNum As Long
4keyNum = UBound(keyArr, 1)
5Dim template As Variant
6ReDim template(keyNum, 0)
7Dim keyCnt As Long
8    
9For keyCnt = 0 To keyNum
10    template(keyCnt, 0) = keyArr(keyCnt)
11Next
12
13'arrsに格納されているdict型のデータをループさせる
14Dim fileNum, file As Integer
15fileNum = UBound(arrs, 1)
16For file = 0 To fileNum
17
18
19'    マージしていく
20    Dim varItems As Variant
21    Dim varItem As Variant
22    Dim columnNum, iDel, varItemsNum As Integer
23    Dim iNum, kNum As Long
24    Dim ce As Variant
25    Dim num, jNum As Long
26    Dim addArr As Variant
27    Dim temp As Variant
28    
29    varItems = arrs(fileNum).Items
30    varItemsNum = UBound(varItems)
31
32
33
34'ジョインする為にtemplateを拡張
35        varItem = varItems(0)
36        '削除したい項目に次の項目を入力していく
37        For iDel = 0 To UBound(varItem) - 1
38            varItem(iDel) = varItem(iDel + 1)
39        Next
40        '配列を1つだけ小さくする
41        ReDim Preserve varItem(UBound(varItem) - 1)
42        ReDim Preserve varItem(1 To UBound(varItem) + 1)
43    
44        columnNum = UBound(varItem) - 1
45        ReDim Preserve template(keyNum, columnNum)
46
47              
48' データを貼り付けていく
49        iNum = 1
50        jNum = 0
51        kNum = 0
52        For kNum = 0 To UBound(template, 2)
53            If arrs(0).Exists(template(kNum, 0)) Then
54                For Each ce In varItems(0)
55                    If jNum = 0 Or jNum = 1 Then
56                        jNum = jNum + 1
57                    Else
58                        template(kNum, iNum) = ce
59                        iNum = iNum + 1
60                    End If
61                Next
62                
63            Else
64                For num = 1 To columnNum
65                    template(kNum, num) = ""
66                    num = num + 1
67                Next
68            End If
69            iNum = 1
70            jNum = 0
71
72        Next
73    Next
74
75
76

理解が難しいこと

ループを回しすぎて、頭がこんがらがってしまいました。
１つ１つ切り分けて考えてみたのですが、それでも解決できませんでした。複雑に考えすぎてしまっているのかもしれないです。

行動規範の内容に同意します

回答1件

ベストアンサー

データの持ち方があまりよろしくないと思います。

二次元配列の中に以下のように加工したデータを持ちたいです。

10万行を超えるデータを二次元配列にするのは、前の質問の二次元配列で重複があった場合にレコードの削除をしたいの回答の追記でも指摘しましたが、使い勝手がよくないように思います。
特定のIDの人のデータを取得したいというときにいちいち先頭からループして探す必要がでてきます。
連想配列のKeyにIDを、Itemにデータを格納すべきだと思います。

ユニークなIDのキーとして、以下の値の一次元配列を持っています。
[ "ID", "1", "2", "3", "4", "5", "6", "7"]

上記の連想配列にすればこのような1次元配列も不要にです。

Itemに格納するデータの形式は、いろいろ考えられますが、
質問の二次元配列の行データを一次元配列として格納するのがシンプルでいいでしょう。

連想配列 Data

Key	Item
"1"	["1","男","20","1","0","2","1","1","0","1","1","1","1","1"]
"2"	["2","女","21","1","2","0","1","","","","","1","1","1"]

こうすれば、
Data("1")(2)
でIDが"1"の人の年齢が取得できます。

項目行は別の連想配列に格納するのがいいでしょう。
Keyに項目名、Itemに列番号を格納します。

連想配列 Field

Key	Item
ID	0
性別	1
年齢	2
肌着	3
ニット	4
シャツ	5
帽子	6
化粧水	7
乳液	8
歯ブラシ	9
整髪料	10
PC	11
スマホ	12
モバイルバッテリー	13

このようにしておけば、IDが"1"の人の年齢は下記で取得できます。
Data("1")(Field("年齢"))

wear, oral, gadget のデータが画像の表のような二次元配列に格納されているとして、それを上記の連想配列に格納するサンプルコードです。

vba
1Public Sub Sample2()
2    Dim wear(4, 6), oral(3, 6), gadget(5, 5)
3    wear(0, 0) = "ID"
4    wear(0, 1) = "性別"
5    wear(0, 2) = "年齢"
6    wear(0, 3) = "肌着"
7    wear(0, 4) = "ニット"
8    wear(0, 5) = "シャツ"
9    wear(0, 6) = "帽子"
10    
11    wear(1, 0) = "1"
12    wear(1, 1) = "男"
13    wear(1, 2) = "20"
14    wear(1, 3) = "1"
15    wear(1, 4) = "0"
16    wear(1, 5) = "2"
17    wear(1, 6) = "1"
18    wear(2, 0) = "2"
19    wear(2, 1) = "女"
20    wear(2, 2) = "21"
21    wear(2, 3) = "1"
22    wear(2, 4) = "2"
23    wear(2, 5) = "0"
24    wear(2, 6) = "1"
25    wear(3, 0) = "3"
26    wear(3, 1) = "女"
27    wear(3, 2) = "19"
28    wear(3, 3) = "1"
29    wear(3, 4) = "1"
30    wear(3, 5) = "1"
31    wear(3, 6) = ""
32    wear(4, 0) = "6"
33    wear(4, 1) = "男"
34    wear(4, 2) = "22"
35    wear(4, 3) = "1"
36    wear(4, 4) = "1"
37    wear(4, 5) = "1"
38    wear(4, 6) = "1"
39
40    oral(0, 0) = "ID"
41    oral(0, 1) = "性別"
42    oral(0, 2) = "年齢"
43    oral(0, 3) = "化粧水"
44    oral(0, 4) = "乳液"
45    oral(0, 5) = "歯ブラシ"
46    oral(0, 6) = "整髪料"
47    
48    oral(1, 0) = "1"
49    oral(1, 1) = "男"
50    oral(1, 2) = "20"
51    oral(1, 3) = "1"
52    oral(1, 4) = "0"
53    oral(1, 5) = "1"
54    oral(1, 6) = "1"
55    oral(2, 0) = "4"
56    oral(2, 1) = "女"
57    oral(2, 2) = "22"
58    oral(2, 3) = "1"
59    oral(2, 4) = "1"
60    oral(2, 5) = "1"
61    oral(2, 6) = "0"
62    oral(3, 0) = "3"
63    oral(3, 1) = "女"
64    oral(3, 2) = "19"
65    oral(3, 3) = "1"
66    oral(3, 4) = "1"
67    oral(3, 5) = "1"
68    oral(3, 6) = "0"
69    
70    gadget(0, 0) = "ID"
71    gadget(0, 1) = "性別"
72    gadget(0, 2) = "年齢"
73    gadget(0, 3) = "PC"
74    gadget(0, 4) = "スマホ"
75    gadget(0, 5) = "モバイルバッテリー"
76    
77    gadget(1, 0) = "1"
78    gadget(1, 1) = "男"
79    gadget(1, 2) = "20"
80    gadget(1, 3) = "1"
81    gadget(1, 4) = "1"
82    gadget(1, 5) = "1"
83    gadget(2, 0) = "2"
84    gadget(2, 1) = "女"
85    gadget(2, 2) = "21"
86    gadget(2, 3) = "1"
87    gadget(2, 4) = "1"
88    gadget(2, 5) = "1"
89    gadget(3, 0) = "5"
90    gadget(3, 1) = "男"
91    gadget(3, 2) = "19"
92    gadget(3, 3) = "1"
93    gadget(3, 4) = "1"
94    gadget(3, 5) = ""
95    gadget(4, 0) = "6"
96    gadget(4, 1) = "男"
97    gadget(4, 2) = "22"
98    gadget(4, 3) = "1"
99    gadget(4, 4) = "1"
100    gadget(4, 5) = "1"
101    gadget(5, 0) = "7"
102    gadget(5, 1) = "女"
103    gadget(5, 2) = "20"
104    gadget(5, 3) = "1"
105    gadget(5, 4) = "1"
106    gadget(5, 5) = "1"
107    
108    Dim Field As Object
109    Set Field = CreateObject("Scripting.Dictionary")
110    
111    Dim i As Long, c As Long
112    For i = 0 To UBound(wear, 2)
113        If Not Field.Exists(wear(0, i)) Then
114            Field.Add wear(0, i), c
115            c = c + 1
116        End If
117    Next
118    For i = 0 To UBound(oral, 2)
119        If Not Field.Exists(oral(0, i)) Then
120            Field.Add oral(0, i), c
121            c = c + 1
122        End If
123    Next
124    For i = 0 To UBound(gadget, 2)
125        If Not Field.Exists(gadget(0, i)) Then
126            Field.Add gadget(0, i), c
127            c = c + 1
128        End If
129    Next
130
131    Dim Data As Object
132    Set Data = CreateObject("Scripting.Dictionary")
133
134    Dim RowData()
135    ReDim RowData(Field.Count - 1)
136
137    For i = 1 To UBound(wear)
138        For c = 0 To UBound(wear, 2)
139            RowData(Field(wear(0, c))) = wear(i, c)
140        Next
141        Data.Add wear(i, 0), RowData
142    Next
143    
144    ReDim RowData(Field.Count - 1)
145    For i = 1 To UBound(oral)
146        If Data.Exists(oral(i, 0)) Then
147            RowData = Data(oral(i, 0))
148        End If
149        For c = 0 To UBound(oral, 2)
150            RowData(Field(oral(0, c))) = oral(i, c)
151        Next
152        Data(oral(i, 0)) = RowData
153    Next
154
155    ReDim RowData(Field.Count - 1)
156    For i = 1 To UBound(gadget)
157        If Data.Exists(gadget(i, 0)) Then
158            RowData = Data(gadget(i, 0))
159        End If
160        For c = 0 To UBound(gadget, 2)
161            RowData(Field(gadget(0, c))) = gadget(i, c)
162        Next
163        Data(gadget(i, 0)) = RowData
164    Next
165
166
167    'フィールド名確認
168    Debug.Print Join(Field.Keys, ",")
169
170    'データ確認
171    Dim d
172    For Each d In Data
173        Debug.Print Join(Data(d), ",")
174    Next
175End Sub

イミディエイトウィンドウへの出力結果

text
1ID,性別,年齢,肌着,ニット,シャツ,帽子,化粧水,乳液,歯ブラシ,整髪料,PC,スマホ,モバイルバッテリー
21,男,20,1,0,2,1,1,0,1,1,1,1,1
32,女,21,1,2,0,1,,,,,1,1,1
43,女,19,1,1,1,,1,1,1,0,,,
56,男,22,1,1,1,1,,,,,1,1,1
64,女,22,1,0,2,1,1,1,1,0,,,
75,男,19,1,2,0,1,,,,,1,1,
87,女,20,1,1,1,1,,,,,1,1,1

投稿2022/10/27 19:26

hatena19

総合スコア33715

taku-s

2022/10/29 14:04 編集

発想が本当に素晴らしく、また非常にわかりやすく噛みくだいて説明していただきありがとうございます。目から鱗です！上記の方法で試してみたところ、挙動の確認がとれました。ただ本当に申し訳ないのですが、私がサンプルで作成したデータが説明不足の部分がありました。実際の仕事で同様の処理を当てはめて動作させると、連想配列Fieldの性別や年齢以外でも項目名がユニークではないものがあり（例えばwearの中に整髪料があり、oralの中にも整髪料があるのですが対応している値は違います。なので、可能であれば連想配列内のキーとして整髪料を2つAddしたいのですが）、うまくできずエラーが発生してしまいます。。（ID列はユニークなのですが）また最終的にCSVファイルで出力をしたいので、二次元配列としてデータを結合できたらと考えておりました。今日１日様々な方法を考えてみたのですが、どんどん沼にはまってしまいどうにもうまくいきません、少しでも解決策があればご教示いただけないでしょうか、本当に質問ばかりですみません。。。

taku-s

2022/10/29 13:55

１つの案としてfieldの連想配列を一次元配列で代用できないかと考えてみたのですが（実際の列は300行弱と少な目なので）、なかなかご教示いただいたプログラムをうまく代替できませんでした。

hatena19

2022/10/29 15:16

連想配列 Field のKeyをグループ名 & フィールド名とすればいいでしょう。ただし、共通なフィールド(id, 性別, 年齢)はグループ名を付けないようにします。

hatena19

2022/10/29 16:10 編集

下記のようなコードでkeyを生成。　　Dim c As Long '列番号　　Dim key As String 　　Dim i As Long 　　For i = 0 To UBound(wear, 2) 　　　　key = wear(0, i) 　　　　If key <> "id" And key <> "性別" And key <> "年齢" Then key = "wear_" & key 　　　　　　　　If Not Field.Exists(key) Then 　　　　　　Field.Add key, c 　　　　　　c = c + 1 　　　　End If 　　Next 以下、同様に keyを生成すればいいでしょう。

taku-s

2022/11/01 02:57

keyの名称を一時的に文字を付け足して、二次元配列に代入する際に除去するんですね！その方法で実行してみたところ挙動がうまくいきました。今回の質問が４日ほど悩んでいたので本当に助かりました、ありがとうございます。

行動規範の内容に同意します