回答編集履歴

1

tuiki

2018/12/05 04:57

投稿

jawa
jawa

スコア3013

test CHANGED
@@ -71,3 +71,231 @@
71
71
 
72
72
 
73
73
  参考になれば幸いです。
74
+
75
+
76
+
77
+
78
+
79
+ VBAでの実装(追記2018/12/05 13:56)
80
+
81
+ ---
82
+
83
+ VBAでの実装を想定しているとのことでしたので、その前のコメントに記述した「関数(Function)の作成」について少し掘り下げてみたいと思います。
84
+
85
+
86
+
87
+ なお、「実績データB列の空欄判定では科目の判別ができない」ということも踏まえて、以下のような流れを考えてみました。
88
+
89
+
90
+
91
+ ===
92
+
93
+ ①関数の引数として、実績データ範囲と、商材名、科目のセルをそれぞれ取得する
94
+
95
+ 例えば
96
+
97
+ ・関数名:fncGetValue
98
+
99
+ ・引数1:実績データ範囲(科目・商材名と数値の2列のセル範囲)
100
+
101
+ ・引数2:商材名(セル)
102
+
103
+ ・引数3:科目(文字列)
104
+
105
+ とすると、
106
+
107
+ `=fncGetValue(A16:B100, A2, B2)`
108
+
109
+ のように指定する
110
+
111
+
112
+
113
+ ②科目をリストアップする
114
+
115
+ 商材名セルが連結セルなので、連結されている行数分だけループ処理を行い、右隣にある科目列から科目名を取得する("粗利"は含めない)
116
+
117
+ ⇒科目のリストを格納するのにはDictionaryオブジェクトの利用をお勧めします。
118
+
119
+ DictionaryにはExistsという存在チェックが用意されていますので、登録されているキーワードの確認が簡単になります。
120
+
121
+ ※Dictionaryオブジェクトを利用するには「ツール」-「参照設定」で`Microsoft.Scripting.Runtime`を追加するか、コード中でCreateObjectする必要があります。
122
+
123
+
124
+
125
+ ③実績データを1行ずつループ処理
126
+
127
+
128
+
129
+ ④実績データの1列目の値が科目ディクショナリに登録されているかチェック
130
+
131
+ ・④-a ⇒登録されていれば「科目」
132
+
133
+ 次の科目が見つかるまで、ここで見つけた科目が実績データの科目となる
134
+
135
+
136
+
137
+ ・④-b ⇒登録されていなければ「商材」
138
+
139
+ 引数で指定された科目・商材と一致する場合は2列目の値を返して処理終了。
140
+
141
+ 一致しない場合は次行の処理へ(③へ戻る)
142
+
143
+
144
+
145
+ ===
146
+
147
+ といった流れで、引数に合致する値を返せると思います。
148
+
149
+
150
+
151
+ 上記をもとにサンプルも作成してみました。
152
+
153
+ ```
154
+
155
+ Function fncGetValue(vrData As Range, vrItem As Range, vrKind As Range)
156
+
157
+
158
+
159
+ Dim ret As Double '戻り値
160
+
161
+ ret = 0
162
+
163
+
164
+
165
+ Dim i As Integer
166
+
167
+
168
+
169
+ '実績データの領域チェック
170
+
171
+ If vrData.Columns.Count < 2 Then
172
+
173
+ fncGetValue = "#Data Err"
174
+
175
+ Exit Function
176
+
177
+ End If
178
+
179
+
180
+
181
+ '科目ディクショナリ
182
+
183
+ '↓Windows.Scripting.Runtimeを参照設定に追加していない場合はこちら
184
+
185
+ 'Dim dicKinds As Object '科目ディクショナリ
186
+
187
+ 'Set dicKinds = CreateObject("Scripting.Dictionary")
188
+
189
+ '↑
190
+
191
+
192
+
193
+ '↓Windows.Scripting.Runtimeを参照設定に追加している場合はこちら
194
+
195
+ Dim dicKinds As Dictionary '科目ディクショナリ
196
+
197
+ Set dicKinds = New Dictionary
198
+
199
+ '↑
200
+
201
+
202
+
203
+ '商材セルの結合サイズから科目ディクショナリを作成
204
+
205
+ For i = 1 To vrItem.MergeArea.Rows.Count
206
+
207
+ If vrItem.Cells(i, 2) <> "粗利" Then
208
+
209
+ dicKinds.Add vrItem.Cells(i, 2).Value, 0
210
+
211
+ End If
212
+
213
+ Next
214
+
215
+
216
+
217
+ Dim strKind As String '実績データの科目
218
+
219
+ Dim strVal1 As String '実績データのA列セル値
220
+
221
+ Dim strVal2 As String '実績データのB列セル値
222
+
223
+
224
+
225
+ '対象範囲をループ処理
226
+
227
+ For i = 1 To vrData.Rows.Count
228
+
229
+ '値取得
230
+
231
+ strVal1 = vrData.Cells(i, 1).Value 'A列
232
+
233
+ strVal2 = vrData.Cells(i, 2).Value 'B列
234
+
235
+
236
+
237
+ If dicKinds.Exists(strVal1) = True Then
238
+
239
+ '科目ディクショナリにある:「科目」
240
+
241
+ strKind = strVal1
242
+
243
+ Else
244
+
245
+ '科目ディクショナリにない:「商材」
246
+
247
+ '今回の抽出対象化判定
248
+
249
+ If strKind = vrKind.Value And strVal1 = vrItem.Value Then
250
+
251
+ ''対象科目の対象商材なら戻り値に加算
252
+
253
+ 'ret = ret + Val(strVal2)
254
+
255
+
256
+
257
+ '見つけたら値を返して終了
258
+
259
+ ret = Val(strVal2)
260
+
261
+ Exit For
262
+
263
+ End If
264
+
265
+ End If
266
+
267
+ Next
268
+
269
+
270
+
271
+ fncGetValue = ret
272
+
273
+
274
+
275
+ End Function
276
+
277
+ ```
278
+
279
+
280
+
281
+ これをVBAで標準モジュールとして記述します。
282
+
283
+
284
+
285
+ 使用する際は、例えば
286
+
287
+ ・売上の値(C2セル)には`=fncGetValue(Sheet1!A$16:B$100, A2, B2)`
288
+
289
+ ・外注の値(C3セル)には`=fncGetValue(Sheet1!A$16:B$100, A2, B3)`
290
+
291
+ ・仕入の値(C4セル)には`=fncGetValue(Sheet1!A$16:B$100, A2, B4)`
292
+
293
+ のような式を記述することで、それぞれ目的の値が出力されると思います。
294
+
295
+
296
+
297
+ コメント多めにしておきましたが、不明な点等あればご確認ください。
298
+
299
+
300
+
301
+ 参考になれば幸いです。