回答編集履歴

3

コード内コメント修正

2021/06/09 09:01

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -110,7 +110,7 @@
110
110
 
111
111
  Else
112
112
 
113
- '重複していなければキー(A列の値)とアイテム(行番号)を追加
113
+ '重複していなければキー(A列の値)とアイテム(出力先行番号)を追加
114
114
 
115
115
  r2 = r2 + 1
116
116
 
@@ -170,7 +170,7 @@
170
170
 
171
171
  処理の流れとしては、
172
172
 
173
-
173
+ ```text
174
174
 
175
175
  Valueでデータ範囲を配列に格納。sourceData
176
176
 
@@ -182,14 +182,20 @@
182
182
 
183
183
  データ配列を1行目から最終行までForループで走査。
184
184
 
185
+  キーが既に存在していたら、
186
+
187
+    出力先配列の値にデータ配列の現在行の値を加算。
188
+
189
+  キーが存在しない場合は、
190
+
185
-  配列の1列目の値をDictionaryのキーとして追加、アイテムは出力先行番号。
191
+   配列の1列目の値をDictionaryのキーとして追加、アイテムは出力先行番号。
186
-
192
+
187
-  キーが既に存在していたら、出力先配列の値に加算
193
+   出力先配列にデータ配列現在行のを転記
188
-
189
-  キーが存在しない場合、A列、B列の値、D列以降の値を出力配列に転記。
190
194
 
191
195
  ループ終了
192
196
 
193
197
 
194
198
 
195
199
  シートを追加して、そこに出力配列をセル範囲のValueに出力。
200
+
201
+ ```

2

解説追記

2021/06/09 09:01

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -149,3 +149,47 @@
149
149
  End Sub
150
150
 
151
151
  ```
152
+
153
+ 解説
154
+
155
+ ---
156
+
157
+ まずは、下記の点を理解しましょう。
158
+
159
+ セル範囲(Rangeオプジェクト)は Valueプロパティで配列として取得できます。
160
+
161
+ また、配列をセル範囲のValueに代入することで一気に入力できます。
162
+
163
+ コードがシンプルになるし高速化するというメリットもあります。
164
+
165
+
166
+
167
+ [Office TANAKA - VBA高速化テクニック[配列を使う]](http://officetanaka.net/excel/vba/speed/s11.htm)
168
+
169
+
170
+
171
+ 処理の流れとしては、
172
+
173
+
174
+
175
+ Valueでデータ範囲を配列に格納。sourceData
176
+
177
+
178
+
179
+ 出力用配列は最大サイズで生成しておく。(sourceDataの行数と同じにする。)
180
+
181
+
182
+
183
+ データ配列を1行目から最終行までForループで走査。
184
+
185
+  配列の1列目の値をDictionaryのキーとして追加、アイテムは出力先行番号。
186
+
187
+  キーが既に存在していたら、出力先配列の値に加算。
188
+
189
+  キーが存在しない場合、A列、B列の値、D列以降の値を出力配列に転記。
190
+
191
+ ループ終了
192
+
193
+
194
+
195
+ シートを追加して、そこに出力配列をセル範囲のValueに出力。

1

コード追記

2021/06/09 08:40

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -33,3 +33,119 @@
33
33
 
34
34
 
35
35
  ざっとしか見てませんが他にもいろいろおかしいところがありそうです。
36
+
37
+
38
+
39
+
40
+
41
+ ---
42
+
43
+
44
+
45
+ たぶん下記のようなことをしたいのかな。
46
+
47
+
48
+
49
+ A列B列は重複を排除、D列以降はA例の値が同じもので合計
50
+
51
+
52
+
53
+ ```vba
54
+
55
+ Public Sub Test()
56
+
57
+ Dim lastLine As Integer
58
+
59
+ lastLine = Cells(Rows.Count, "A").End(xlUp).Row
60
+
61
+
62
+
63
+ Dim sourceData() As Variant
64
+
65
+ sourceData = Range("A1:O" & lastLine).Value 'データ範囲を配列に格納(C列含む)
66
+
67
+
68
+
69
+
70
+
71
+ Dim areaName As Object
72
+
73
+ Set areaName = CreateObject("Scripting.Dictionary")
74
+
75
+
76
+
77
+ Dim outoutData()
78
+
79
+ ReDim outoutData(1 To lastLine, 1 To 14) '出力用配列 サイズは大きめにとっておく
80
+
81
+
82
+
83
+
84
+
85
+ Dim r As Long, c As Long, r2 As Long
86
+
87
+
88
+
89
+ For r = 1 To UBound(sourceData)
90
+
91
+ If areaName.Exists(sourceData(r, 1)) Then
92
+
93
+ Dim r3 As Long
94
+
95
+ r3 = areaName(sourceData(r, 1))
96
+
97
+
98
+
99
+ outoutData(r3, 2) = sourceData(r, 2)
100
+
101
+
102
+
103
+ '重複していたら出力配列に加算(D列以降)
104
+
105
+ For c = 3 To 14
106
+
107
+ outoutData(r3, c) = outoutData(r3, c) + sourceData(r, c + 1)
108
+
109
+ Next
110
+
111
+ Else
112
+
113
+ '重複していなければキー(A列の値)とアイテム(行番号)を追加
114
+
115
+ r2 = r2 + 1
116
+
117
+ areaName.Add sourceData(r, 1), r2
118
+
119
+
120
+
121
+ outoutData(r2, 1) = sourceData(r, 1)
122
+
123
+ outoutData(r2, 2) = sourceData(r, 2)
124
+
125
+ For c = 3 To 14
126
+
127
+ outoutData(r2, c) = sourceData(r, c + 1)
128
+
129
+ Next
130
+
131
+ End If
132
+
133
+ Next
134
+
135
+
136
+
137
+ '新規シートを名前を変更してシートの最後尾に挿入
138
+
139
+ Dim NewWorkSheet As Worksheet
140
+
141
+ Set NewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
142
+
143
+ NewWorkSheet.Name = "Sheet2"
144
+
145
+
146
+
147
+ NewWorkSheet.Cells(4, 2).Resize(r2, 14).Value = outoutData
148
+
149
+ End Sub
150
+
151
+ ```