利用記録というシートの各列に、
・利用開始時間
・利用終了時間
・利用者種類(3種
・利用物種類(2種
・利用日
・他
というデータが3万行ほどあります。
例:2行目
09:55:23| 11:29:51| 一般| ボール| 2019/4/5| 他項目| 他項目|・・・・
|:--|:--:|--:|
このデータから
日別時間帯別の集計をしなければなりません。
例:2019/4/5時間帯別利用者別種類別集計
|||9:0012:00|9:0012:00|12:0017:00|12:0017:00|17:0021:00|17:0021:00|
|:--|:--:|--:|
|||ボール|バット|ボール|バット|ボール|バット|||
|5|幼児・小|3|2|2|0|1|4
||中高生|4|4|3|5|1|4
||一般|2|4|2|0|5|6|
※ずれているかもです。すみません。
これを各月30日程度×12ヶ月分です。
一度データを配列に入れて、if分で
1.日付で
2.利用者で
3.利用種類で
4.時間で
と絞って記載しようとしましたが、非常に非効率的な気がします。
大まかな考え方、スマートな集計方法を教えていただけないでしょうか。
下記はとりあえず1日分のさらに9時~12時で抽出しようとしたものです。正常に動きますがこれを利用者分・時間帯別分、30日分、12か月分と思うと気が遠くなりそうです。
ちなみに・・・。表の様式は変えられません。
あとでループで廻そうとして変な変数を使っています。
VBA
1Sub 日別集計() 2 Dim i As Long, n As Long, m As Long 3 Dim y As String, z As String 4 Dim cnt(1 To 20) As Long 5 Dim buf As Variant 6 Dim x(1 To 3) As String 7 Dim dt As Date 8 9 x(1) = "幼児・小学生" 10 x(2) = "中・高校生" 11 x(3) = "一般" 12 13 Sheets("利用記録").Select 14 i = Sheets("利用記録").Cells(2, 1).End(xlDown).Row 15 buf = Sheets("利用記録").Range(Cells(2, 1), Cells(i, 12)).Value 16 Sheets("1").Select 17 cnt(20) = 1'--------------取り合えず1日分 18 19 For i = 6 To 13 Step 2 20 For n = 1 To UBound(buf) 21 dt = Range("a1") & "/" & Range("a7") & "/" & cnt(20) 22 If buf(n, 10) = dt Then 23 If Format(buf(n, 6), "Short Time") > "09:00" And Format(buf(n, 6), "Short Time") < "12:00" Then 24 If buf(n, 5) = x(1) And buf(n, 8) <> "ICT" Then 25 cnt(1) = cnt(1) + buf(n, 7) 26 Else 27 cnt(2) = cnt(2) + buf(n, 7) 28 End If 29 End If 30 End If 31 Next n 32 Cells(9, i) = cnt(1) 33 Cells(9, i + 1) = cnt(2) 34 cnt(1) = 0 35 cnt(2) = 0 36 Next i 37 38 39 40 41End Sub
ピポットテーブルは手付かずで、ご助言いただいたことを参考に勉強します。とりあえず回答順に参考にさせていただきました。記述も少なくて済み、処理時間もそれほど長くなかったのでシンプルに考えられました。
効率的といえばピポットテーブルだということも理解できました。
vba
1Sub 集計テスト() 2 Dim i As Long, n As Long, m As Long, l As Long 3 Dim x As String, y As String, z As String 4 Dim cnt(1 To 20) As Long 5 Dim buf As Variant 6 Dim ws As Worksheet 7 Dim rng As Range 8 9Application.ScreenUpdating = False 10 For i = 8 To 19 11 Sheets(i).Range("f9:m101").ClearContents 12 Next i 13 14 Set ws = Sheets("利用記録") 15 i = ws.Cells(1, 1).End(xlDown).Row 16 buf = ws.Cells(2, 1).Resize(i, 12).Value 17 18 For i = 1 To UBound(buf) 19 Sheets(Month(buf(i, 10)) & "月").Select 20 n = Day(buf(i, 10)) 21 Set rng = Range("b8:b101").Find(what:=n, lookat:=xlWhole).Offset(0, 3) 22 23 24 If buf(i, 5) = "幼児・小学生" Then 25 m = rng.Offset(0, 1).Row 26 ElseIf buf(i, 5) = "中・高校生" Then 27 m = rng.Offset(1, 1).Row 28 ElseIf buf(i, 5) = "一般" Then 29 m = rng.Offset(2, 1).Row 30 End If 31 32 If Format(buf(i, 6), "Short Time") > "09:00" And Format(buf(i, 6), "Short Time") <= "12:00" Then 33 l = 6 34 ElseIf Format(buf(i, 6), "Short Time") > "12:00" And Format(buf(i, 6), "Short Time") <= "17:00" Then 35 l = 8 36 ElseIf Format(buf(i, 6), "Short Time") > "17:00" And Format(buf(i, 6), "Short Time") <= "19:00" Then 37 l = 10 38 ElseIf Format(buf(i, 6), "Short Time") > "19:00" And Format(buf(i, 6), "Short Time") <= "21:00" Then 39 l = 12 40 End If 41 42 If buf(i, 8) = "バット" Then 43 l = l + 1 44 End If 45 46 Cells(m, l).Value = Cells(m, l).Value + buf(i, 7) '利用人数の項目があったためこれを追記 47 Next i 48 49Application.ScreenUpdating = True 50End Sub
皆さんありがとうございました。
回答4件
あなたの回答
tips
プレビュー