VBA初心者が8時間で工数集計ツールを作成してみた

工数集計楽にしたい

月末に必ずと言っていいほど、工数の集計作業があるのですが、それをまだ手作業で集計してました。毎月1時間くらいだけど地味に時間取られるので、VBAで集計してもらうようにしてみました。

実際の動きはこちら

工数集計するVBA作成してみた。
これで、月末の集計処理楽にしたい！
※数字とかはテスト用の適当なものです。 pic.twitter.com/JiV0bEbGMB

— heihei (@heihei15408697) November 13, 2020

実際に使ってみた

会社の同僚に使ってみてもらっての意見をもらいました。
・今まで手作業で集計していたので、助かる。
・集計だけでなくて、必要な情報も付与してもらいたい。（システムの責任者、責任者が所属する部署、システムの日本語名）
・VBAを修正せずに、ファイルを置いてある場所を自分で選択できるようにしてほしい。

なるほど・・・

自分では思ってなかったところの指摘だなと勉強になりました。
下記の修正をやっていこうと思います！

・集計だけでなくて、必要な情報も付与してもらいたい。（システムの責任者、責任者が所属する部署、システムの日本語名）
→別シートにマスタシートのようなものを作成して情報を結合するようにする。

・VBAを修正せずに、ファイルを置いてある場所を自分で選択できるようにしてほしい。
→これも別シートに記載できるようにして取ってくるようにする。

使ったもの

VBA

プログラム

実際に使ってもらったもののソースコードです。
※もらった意見の修正版ではないので注意！

Sub Main()
    'ファイル名
    Dim FileName As String
    'フォルダ名
    Const FolderPath As String = "Excelを配置しているパス"

    'ファイルを取得し中のデータをコピー
    FileName = Dir(FolderPath & "*.xlsx")
    Do While FileName <> ""
        MsgBox FileName
        SheetCopy (FolderPath & FileName)
        FileName = Dir()
    Loop

    '不要データ削除
    DeleteUnnecessaryData

    'システムID別用ピボット用シート作成
    CreatePivotTableBySystemId
    
    'システムID別用ピボット用シートに項目設定
    AddPivotFieldsBySystemId
    
    '担当者別用ピボット用シート作成
    CreatePivotTableByPerson
    
    '担当者別用ピボット用シートに項目設定
    AddPivotFieldsByPerson
End Sub

'別ファイルのシートをコピー
Sub SheetCopy(FileName As String)
    'コピー元
    Dim WorkBase As Workbook
    'コピー先
    Dim WorkCopy As Workbook
    
    'コピー先のブック名をセット
    Set WorkCopy = ActiveWorkbook

    Application.DisplayAlerts = False
    
    'コピー元ファイルを読み取り専用で開く
    Workbooks.Open FileName:=FileName, ReadOnly:=True, UpdateLinks:=0
    
    '開いたコピー元をセット
    Set WorkBase = Workbooks.Open(FileName)

    'コピー元シート名の「勤務表」セルI13:O列の範囲をコピー
    Dim baseLowRow As Long
    baseLowRow = WorkBase.Worksheets("勤務表").Cells(Rows.Count, 11).End(xlUp).Row
    WorkBase.Worksheets("勤務表").Range("I13:O" & baseLowRow).Copy
    
    'コピー先シート名「データ」B2から貼り付け
    Dim beforeCopyLowRow As Long
    beforeCopyLowRow = WorkCopy.Worksheets("データ").Cells(Rows.Count, 2).End(xlUp).Row
    WorkCopy.Worksheets("データ").Range("B" & beforeCopyLowRow + 1).PasteSpecial xlPasteFormulasAndNumberFormats

    'コピーを解除
    Application.CutCopyMode = False
    
    '名前欄をコピー
    WorkBase.Worksheets("勤務表").Range("AA6:AA6").Copy
    
    '明細に名前を貼り付け
    Dim afterCopyLowRow As Long
    afterCopyLowRow = WorkCopy.Worksheets("データ").Cells(Rows.Count, 2).End(xlUp).Row
    WorkCopy.Worksheets("データ").Range("A" & beforeCopyLowRow + 1 & ":A" & afterCopyLowRow).PasteSpecial xlPasteFormulasAndNumberFormats

    'コピー元のファイルを閉じる
    WorkBase.Close False

    Application.DisplayAlerts = True
End Sub

'不要データ削除
Sub DeleteUnnecessaryData()
    Dim lowRow As Long
    Dim i As Long
    
    lowRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    'E列が空白か0であれば、削除
    For i = lowRow To 2 Step -1
        If VarType(Cells(i, 5)) = vbEmpty Or Cells(i, 5) = 0 Then
            Range(i & ":" & i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

'システムID別ピボット用シート作成
Sub CreatePivotTableBySystemId()
    'データシート
    Dim DataS As Worksheet
    'ピボットテーブルを作成するシート
    Dim PivotS As Worksheet
    'ピボットキャッシュ用変数
    Dim PCache As PivotCache

    Set DataS = ThisWorkbook.Worksheets("データ")
    
    '「データ」シートからピボットキャッシュを作成
    Dim lowRow As Long
    lowRow = ActiveWorkbook.Worksheets("データ").Cells(Rows.Count, 2).End(xlUp).Row
    Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataS.Range("B1:E" & lowRow))
    
    'ピボットテーブル用シートを追加
    Worksheets.Add
    ActiveSheet.Name = "システムID別集計"
    Set PivotS = ThisWorkbook.Worksheets("システムID別集計")
    
    'ピボットテーブル用シートにピボットテーブル作成
    PCache.CreatePivotTable TableDestination:=PivotS.Range("A1"), TableName:="システムID別集計"
End Sub

'システムID別ピボット用シートに項目設定
Sub AddPivotFieldsBySystemId()
    'ピボットテーブルがあるシート
    Dim PivotS As Worksheet
    
    Set PivotS = ThisWorkbook.Worksheets("システムID別集計")
    
    'ピボットテーブルに行と列フィールドを追加
    PivotS.PivotTables("システムID別集計").AddFields ColumnFields:=Array("場所"), RowFields:=Array("システムID")
    
    'ピボットテーブルに値フィールドを追加
    PivotS.PivotTables("システムID別集計").AddDataField Field:=PivotS.PivotTables("システムID別集計").PivotFields("時間"), Function:=xlSum
End Sub

'担当者別ピボット用シート作成
Sub CreatePivotTableByPerson()
    'データシート
    Dim DataS As Worksheet
    'ピボットテーブルを作成するシート
    Dim PivotS As Worksheet
    'ピボットキャッシュ用変数
    Dim PCache As PivotCache

    Set DataS = ThisWorkbook.Worksheets("データ")
    
    '「データ」シートからピボットキャッシュを作成
    Dim lowRow As Long
    lowRow = ActiveWorkbook.Worksheets("データ").Cells(Rows.Count, 1).End(xlUp).Row
    Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataS.Range("A1:E" & lowRow))
    
    'ピボットテーブル用シートを追加
    Worksheets.Add
    ActiveSheet.Name = "担当者別集計"
    Set PivotS = ThisWorkbook.Worksheets("担当者別集計")
    
    'ピボットテーブル用シートにピボットテーブル作成
    PCache.CreatePivotTable TableDestination:=PivotS.Range("A1"), TableName:="担当者別集計"
End Sub

'担当者別ピボット用シートに項目設定
Sub AddPivotFieldsByPerson()
    'ピボットテーブルがあるシート
    Dim PivotS As Worksheet
    
    Set PivotS = ThisWorkbook.Worksheets("担当者別集計")
    
    'ピボットテーブルに行と列フィールドを追加
    PivotS.PivotTables("担当者別集計").AddFields ColumnFields:=Array("場所"), RowFields:=Array("担当者")
    
    'ピボットテーブルに値フィールドを追加
    PivotS.PivotTables("担当者別集計").AddDataField Field:=PivotS.PivotTables("担当者別集計").PivotFields("時間"), Function:=xlSum
End Sub