和風スパゲティのレシピ

日本語でコーディングするExcelVBA

トップ > 100本ノック > 91本目：時間計算（残業時間の月間合計）

91本目：時間計算（残業時間の月間合計）

100本ノック 日付・時刻 VBA

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：時間計算（残業時間の月間合計）

#VBA100本ノック 91本目
「勤怠」に複数月の勤怠データが入っています。
9:00～18:00の休憩1hの実動8hです。
id・月ごとに残業時間を算出し「残業」に一覧出力。
残業：単純に1日8hを超える時間数。ただし9時前出勤は9時とする。
日々1分単位、月間30分単位で切り捨て。
※時間計算の練習問題です。

元データ
目的の集計表

◇ 出題ページはこちら

ソースコード

定数定義モジュール

Option Explicit

Public Const Time始業時刻 As Date = "9:00:00"
Public Const Minute勤務時間休憩込 As Long = 60 * 9

Public Const R1st勤怠 = 2
Public Const C1st勤怠 = 1
Public Enum CNo勤怠
    ID = C1st勤怠
    日付
    出勤時刻
    退勤時刻
    計算出勤時刻
    計算出勤退勤差
    分単位残業
End Enum
Public Const C1st勤怠_追加列 = 計算出勤時刻
Public Const CLast勤怠 = CNo勤怠.分単位残業

Public Const R1st残業 = 2
Public Const C1st残業 = 1
Public Enum CNo残業
    ID = C1st残業
    年月
    残業
End Enum
Public Const CLast残業 = CNo残業.残業

メインモジュール

' 100本ノック091：時間計算（残業時間の月間合計）
Sub IDごとの月別残業時間を計算する()
    
    Call エクセルの自動更新を停止する(False)
    
    Call 勤怠シートに計算用作業列を追加する
    
    Dim Dic月別残業時間 As New Dictionary
    Set Dic月別残業時間 = CreateDictioanry月別残業時間
    
    Call 残業シートへ月別残業時間を出力する(Dic月別残業時間)
    
    Call 勤怠シートの計算用作業列を削除する
    
    Call エクセルの自動更新を開始する
    
End Sub

' 計算用作業列の追加
Sub 勤怠シートに計算用作業列を追加する()
    With WS勤怠

        .Cells(R1st勤怠 - 1, CNo勤怠.計算出勤時刻) = "計算出勤時刻"
        .Columns(CNo勤怠.計算出勤時刻).NumberFormatLocal = "[h]:mm:dd"
        .Cells(R1st勤怠 - 1, CNo勤怠.計算出勤退勤差) = "計算出勤退勤差"
        .Columns(CNo勤怠.計算出勤退勤差).NumberFormatLocal = "[h]:mm:dd"
        .Cells(R1st勤怠 - 1, CNo勤怠.分単位残業) = "分単位残業"
        
        Dim R As Long
        For R = R1st勤怠 To Get最終行(WS勤怠)

            .Cells(R, CNo勤怠.計算出勤時刻) = Fx.Max(Time始業時刻, .Cells(R, CNo勤怠.出勤時刻))
            .Cells(R, CNo勤怠.計算出勤退勤差) = .Cells(R, CNo勤怠.退勤時刻) - .Cells(R, CNo勤怠.計算出勤時刻)
            .Cells(R, CNo勤怠.分単位残業) = Fx.Max(0, _
                60 * Hour(.Cells(R, CNo勤怠.計算出勤退勤差)) _
                    + Minute(.Cells(R, CNo勤怠.計算出勤退勤差)) - Minute勤務時間休憩込)

        Next

    End With
End Sub

Function CreateDictioanry月別残業時間() As Dictionary
    
    ' key:ID×年月 Item:残業時間(分)のDictionaryで計算
    Dim Dic As New Dictionary
    
    ' 勤怠シート全行をループしてID月ごとの残業時間を合計
    Dim R As Long
    For R = R1st勤怠 To Get最終行(WS勤怠)
        
        Dim keyID_年月
        keyID_年月 = WS勤怠.Cells(R, CNo勤怠.ID) & "_" & Format(WS勤怠.Cells(R, CNo勤怠.日付), "yyyymm")

        Dic(keyID_年月) = Dic(keyID_年月) + WS勤怠.Cells(R, CNo勤怠.分単位残業)
    
    Next
    
    Set CreateDictioanry月別残業時間 = Dic
    
End Function

' 月別残業時間の計算
Sub 残業シートへ月別残業時間を出力する(Dic月別残業時間 As Dictionary)
    
    Call 指定行より下をすべて削除する(WS残業, R1st残業)
    
    ' 残業シートへ結果を出力
    Dim R As Long: R = R1st残業
    Dim keyID_年月
    For Each keyID_年月 In Dic月別残業時間.Keys
    
        WS残業.Cells(R, CNo残業.ID) = Left文字列まで(keyID_年月, "_")
        WS残業.Cells(R, CNo残業.年月) = Right文字列まで(keyID_年月, "_")
        
        ' 残業時間は出力時に30分単位に切り捨て
        Dim 残業時間 As Long: 残業時間 = Dic月別残業時間(keyID_年月)
        WS残業.Cells(R, CNo残業.残業) = Int(残業時間 / 30) * 30 / 60 / 24
        
        R = R + 1
    
    Next
    
End Sub

' 計算用作業列の削除
Sub 勤怠シートの計算用作業列を削除する()
    With WS勤怠
    
        .Range(.Columns(C1st勤怠_追加列), .Columns(CLast勤怠)).Delete
    
    End With
End Sub

汎用関数モジュール

' WorksheetFunctionの短縮取得
' 参考：https://www.limecode.jp/entry/utility/shortcall-worksheetfunction
Function Fx() As WorksheetFunction
    Set Fx = WorksheetFunction
End Function

' 指定行より下の削除
' 参考：https://www.limecode.jp/entry/utility/delete-rows-below-to-last
Sub 指定行より下をすべて削除する(対象シート As Worksheet, 指定行 As Long)
    With 対象シート

        Call フィルターをクリアする(対象シート)

        .Range(.Rows(指定行), .Rows(.Rows.Count)).Delete

    End With
End Sub

' フィルターのクリア
' ◆ ブログ未掲載
Sub フィルターをクリアする(対象シート As Worksheet)
    If 対象シート.AutoFilterMode = True Then
        If 対象シート.AutoFilter.FilterMode = True Then
            対象シート.AutoFilter.ShowAllData
        End If
    End If
End Sub
'
' 最終行の取得
' 参考：https://www.limecode.jp/entry/library/get-lastrow-lastcolumn
Function Get最終行(指定オブジェクト As Variant, Optional ByVal C As Long = -1) As Long

    ' 渡されたオブジェクトからセル範囲を取得
    Dim 対象セル範囲 As Range
    Select Case TypeName(指定オブジェクト)
    Case "Range"
        If 指定オブジェクト.Cells.CountLarge = 1 Then ' 単独セルにはCurrentRegionを取る
            Set 対象セル範囲 = 指定オブジェクト.CurrentRegion
        Else
            Set 対象セル範囲 = 指定オブジェクト
        End If
    Case "Worksheet"
        Set 対象セル範囲 = 指定オブジェクト.UsedRange
    Case "AutoFilter", "ListObject"
        Set 対象セル範囲 = 指定オブジェクト.Range
    Case Else
        Err.Raise 1000, , "対象外のオブジェクト「" & TypeName(指定オブジェクト) & "」が指定されました。"
    End Select

    ' エリアの最終行を取得
    Get最終行 = 対象セル範囲.Rows.Count + 対象セル範囲.Row - 1

    ' 列が指定されていればその列の入力最終行を取得
    If C <> -1 Then
        Do While 対象セル範囲.Worksheet.Cells(Get最終行, C) = ""
            Get最終行 = Get最終行 - 1
            If Get最終行 < 対象セル範囲.Row Then
                Get最終行 = 0
                Exit Function
            End If
        Loop
    End If

End Function

' 文字列検索切り出しLeft/Right/Mid
' 参考：https://www.limecode.jp/entry/library/string-manipulation
Function Left文字列まで(ByVal 元テキスト As String, ByVal 検索値 As String _
    , Optional is検索値を結果に含む As Boolean = False) As String

    Dim instr位置 As Long: instr位置 = InStr(元テキスト, 検索値)
    If instr位置 > 0 Then
        Left文字列まで = Left(元テキスト, instr位置 - 1) & IIf(is検索値を結果に含む, 検索値, "")
    End If

End Function
Function Right文字列まで(ByVal 元テキスト As String, ByVal 検索値 As String _
    , Optional is検索値を結果に含む As Boolean = False) As String

    Dim instrRev位置 As Long: instrRev位置 = InStrRev(元テキスト, 検索値)
    If instrRev位置 > 0 Then
        Right文字列まで = IIf(is検索値を結果に含む, 検索値, "") _
                                          & Mid(元テキスト, instrRev位置 + Len(検索値))
    End If

End Function
Function Mid文字列から文字列(ByVal 元テキスト As String, ByVal 前検索値 As String, ByVal 後検索値 As String _
    , Optional is前検索値を結果に含む As Boolean = False, Optional is後検索値を結果に含む As Boolean = False) As String

    Dim instr前値 As Long: instr前値 = InStr(元テキスト, 前検索値)
    If instr前値 = 0 Then Exit Function

    Dim instr後値 As Long: instr後値 = InStr(instr前値 + Len(前検索値) + 1, 元テキスト, 後検索値)
    If instr後値 = 0 Then Exit Function

    Mid文字列から文字列 = _
        IIf(is前検索値を結果に含む, 前検索値, "") & _
        Mid(元テキスト, instr前値 + Len(前検索値), instr後値 - instr前値 - Len(前検索値)) & _
        IIf(is後検索値を結果に含む, 後検索値, "")

End Function

' 自動更新の停止
Sub エクセルの自動更新を停止する(isブック計算をOFFに As Boolean _
    , Optional is画面更新をOFFに As Boolean = True _
    , Optional isイベントをOFFに As Boolean = True)

    If isブック計算をOFFに Then Application.Calculation = xlCalculationManual
    If is画面更新をOFFに Then Application.ScreenUpdating = False
    If isイベントをOFFに Then Application.EnableEvents = False

End Sub

' 自動更新の開始
Sub エクセルの自動更新を開始する()
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
        .StatusBar = False
        .DisplayAlerts = True
    End With
End Sub

解説

メインプロシージャを見るとわかる通り

  1. 勤怠シートに作業列を追加
  2. 作業列を用いてDictioanryへグループ集計
  3. Dictionaryの内容を残業シートへ出力
  4. 勤怠シートの作業列を削除

という手順で処理を行っています。


今回は「9:00前の出勤を9:00に」「日ごとに分を切り捨て」「月ごとに30分を切り捨て」といった不可逆計算を逐次行う必要があります。

この計算を一気にやってしまうと不具合があった際に調査が困難になりますからね。

これらの計算を作業列・Dictionaryに残しておくことで、
デバッグ作業や改修作業をやりやすくしています。


Dictionaryを新規シートに出力する関数を使ったり、
「Call 勤怠シートの計算用作業列を削除する」をコメントアウトすれば、
途中結果をワークシート上でしっかりと確認することができます。

特に時間計算はバグや仕様漏れ・仕様の追加が起きやすい業務ですので、
メンテナンス性を意識したコードを書きましょう。


また、分・秒の計算は単独であれば誤差は生じにくいですが、
合算などを行うとズレが生じる可能性があります。


今回のように「分の整数」などにして計算を行うと安全になりますので、
これも作業列として残して処理しておきましょう。