質問編集履歴
1
解決
test
CHANGED
File without changes
|
test
CHANGED
@@ -161,3 +161,117 @@
|
|
161
161
|
End Sub
|
162
162
|
|
163
163
|
```
|
164
|
+
|
165
|
+
|
166
|
+
|
167
|
+
ピポットテーブルは手付かずで、ご助言いただいたことを参考に勉強します。とりあえず回答順に参考にさせていただきました。記述も少なくて済み、処理時間もそれほど長くなかったのでシンプルに考えられました。
|
168
|
+
|
169
|
+
効率的といえばピポットテーブルだということも理解できました。
|
170
|
+
|
171
|
+
|
172
|
+
|
173
|
+
```vba
|
174
|
+
|
175
|
+
Sub 集計テスト()
|
176
|
+
|
177
|
+
Dim i As Long, n As Long, m As Long, l As Long
|
178
|
+
|
179
|
+
Dim x As String, y As String, z As String
|
180
|
+
|
181
|
+
Dim cnt(1 To 20) As Long
|
182
|
+
|
183
|
+
Dim buf As Variant
|
184
|
+
|
185
|
+
Dim ws As Worksheet
|
186
|
+
|
187
|
+
Dim rng As Range
|
188
|
+
|
189
|
+
|
190
|
+
|
191
|
+
Application.ScreenUpdating = False
|
192
|
+
|
193
|
+
For i = 8 To 19
|
194
|
+
|
195
|
+
Sheets(i).Range("f9:m101").ClearContents
|
196
|
+
|
197
|
+
Next i
|
198
|
+
|
199
|
+
|
200
|
+
|
201
|
+
Set ws = Sheets("利用記録")
|
202
|
+
|
203
|
+
i = ws.Cells(1, 1).End(xlDown).Row
|
204
|
+
|
205
|
+
buf = ws.Cells(2, 1).Resize(i, 12).Value
|
206
|
+
|
207
|
+
|
208
|
+
|
209
|
+
For i = 1 To UBound(buf)
|
210
|
+
|
211
|
+
Sheets(Month(buf(i, 10)) & "月").Select
|
212
|
+
|
213
|
+
n = Day(buf(i, 10))
|
214
|
+
|
215
|
+
Set rng = Range("b8:b101").Find(what:=n, lookat:=xlWhole).Offset(0, 3)
|
216
|
+
|
217
|
+
|
218
|
+
|
219
|
+
|
220
|
+
|
221
|
+
If buf(i, 5) = "幼児・小学生" Then
|
222
|
+
|
223
|
+
m = rng.Offset(0, 1).Row
|
224
|
+
|
225
|
+
ElseIf buf(i, 5) = "中・高校生" Then
|
226
|
+
|
227
|
+
m = rng.Offset(1, 1).Row
|
228
|
+
|
229
|
+
ElseIf buf(i, 5) = "一般" Then
|
230
|
+
|
231
|
+
m = rng.Offset(2, 1).Row
|
232
|
+
|
233
|
+
End If
|
234
|
+
|
235
|
+
|
236
|
+
|
237
|
+
If Format(buf(i, 6), "Short Time") > "09:00" And Format(buf(i, 6), "Short Time") <= "12:00" Then
|
238
|
+
|
239
|
+
l = 6
|
240
|
+
|
241
|
+
ElseIf Format(buf(i, 6), "Short Time") > "12:00" And Format(buf(i, 6), "Short Time") <= "17:00" Then
|
242
|
+
|
243
|
+
l = 8
|
244
|
+
|
245
|
+
ElseIf Format(buf(i, 6), "Short Time") > "17:00" And Format(buf(i, 6), "Short Time") <= "19:00" Then
|
246
|
+
|
247
|
+
l = 10
|
248
|
+
|
249
|
+
ElseIf Format(buf(i, 6), "Short Time") > "19:00" And Format(buf(i, 6), "Short Time") <= "21:00" Then
|
250
|
+
|
251
|
+
l = 12
|
252
|
+
|
253
|
+
End If
|
254
|
+
|
255
|
+
|
256
|
+
|
257
|
+
If buf(i, 8) = "バット" Then
|
258
|
+
|
259
|
+
l = l + 1
|
260
|
+
|
261
|
+
End If
|
262
|
+
|
263
|
+
|
264
|
+
|
265
|
+
Cells(m, l).Value = Cells(m, l).Value + buf(i, 7) '利用人数の項目があったためこれを追記
|
266
|
+
|
267
|
+
Next i
|
268
|
+
|
269
|
+
|
270
|
+
|
271
|
+
Application.ScreenUpdating = True
|
272
|
+
|
273
|
+
End Sub
|
274
|
+
|
275
|
+
```
|
276
|
+
|
277
|
+
皆さんありがとうございました。
|