勤務時間を計算するVBAで実労時間を計算表に表示する

Option Explicit

    Public EmpName As String, 年月日 As String
    Public OriBName As String
    Public TCos, TwCos, TMal, KMal
    Public SD, ED As Variant
    Public KShH As Boolean
    Dim SaName As String, SaNamea As String

Sub 設定値代入()
    Dim MB As Long
        Worksheets("初期設定項目").Select
'会計期間をセット
        Range("D5", "F5").NumberFormatLocal = "dd"
STEP0:
        If Range("D5") = "" Then
            MsgBox "会計期間が未入力です。" & vbCrLf & "入力してください。" _
                        , vbExclamation, "時給計算表作成"
STOP1:
            On Error Resume Next
            SD = Application.InputBox("開始日を入力してください。", _
                        Title:="時給計算表作成", Type:=2)
            On Error GoTo 0
            If SD = False Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            ElseIf SD = "" Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            ElseIf SD < 1 Or SD > 31 Then
                MsgBox "異常値ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            Else
                With Worksheets("初期設定項目")
                    .Range("D5").Value = SD
                End With
            End If
        ElseIf Range("D5") < 1 Or Range("D5") > 31 Then
            MsgBox "異常値ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
            Range("D5") = ""
            GoTo STEP0:
        Else
            With Worksheets("初期設定項目")
                .Range("D5").Value = SD
            End With
        End If
STEP2:
        If Range("F5") = "" Then
            MsgBox "会計期間が未入力です。" & vbCrLf & "入力してください。" _
                        , vbExclamation, "時給計算表作成"
STOP3:
            On Error Resume Next
            ED = Application.InputBox("開始日を入力してください。", _
                        Title:="時給計算表作成", Type:=2)
            On Error GoTo 0
            If ED = False Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            ElseIf ED = "" Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            ElseIf ED < 1 Or ED > 31 Then
                MsgBox "異常値ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            Else
                With Worksheets("初期設定項目")
                    .Range("F5").Value = ED
                End With
            End If
        ElseIf Range("F5") < 1 Or Range("F5") > 31 Then
            MsgBox "異常値ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
            Range("F5") = ""
            GoTo STEP2:
        Else
            With Worksheets("初期設定項目")
                .Range("F5").Value = ED
            End With
        End If
        With Worksheets("初期設定項目")
            SD = .Range("D5").Value
            ED = .Range("F5").Value
        End With
'対象者名を変数に代入します
        EmpName = Worksheets("初期設定項目").Range("C6").Value
'基本時給をセット
        TCos = Worksheets("初期設定項目").Range("C7").Value
'時間外割増率をセット
        TwCos = Worksheets("初期設定項目").Range("F7").Value / 100
'時間マルメをセット
        TMal = Worksheets("初期設定項目").Range("C8").Value
'金額マルメをセット
        KMal = Worksheets("初期設定項目").Range("C9").Value
'計算シートの保存法を取得
        KShH = Worksheets("初期設定項目").Range("E10").Value
End Sub

Sub 時間計算()
    Dim Sh As Worksheet
    Dim res As Boolean
    Dim myRange As Range, r As Range
    Dim rV As Date
    Dim rR As Long, rC As Long
    Dim i As Long
    Dim B32V As String
        Call Module1.設定値代入
'計算するシートが存在するかを調べる
        res = False
        For Each Sh In Worksheets
            If Sh.Name = EmpName & "時給計算表" Then
                res = True
                Worksheets(EmpName & "時給計算表").Select
                Exit For
            End If
        Next
'ない場合はプロシージャーを終了する
        If res = False Then
            MsgBox "まだ何も設定されていません。", vbExclamation, _
                        "時給計算表作成"
            Exit Sub
        End If
'記入データ行数を調べます
        B32V = Range("B32")
        Range("B32") = ""
        BRow = Cells(Rows.Count, 2).End(xlUp).Row
'記入データが無い場合はプロシージャーを終了します
        If BRow <= 2 Then
            MsgBox "データが入力されていません。", vbExclamation, _
                        "時給計算表作成"
            Exit Sub
        End If
        Range("B32") = B32V
'時間データ用の入力セルをオブジェクト変数に代入
        Set myRange = Range("C3:H" & BRow)
'24時以上の表記を出来るようにします
        myRange.NumberFormatLocal = "[h]:mm;@"
        For Each r In myRange
            r.Select
'入力されたセル値が時刻ではない時エラー処理を行います
            On Error GoTo step_err
            rV = r.Value
            rR = r.Row
            rC = r.Column
        Next
        For i = 3 To BRow
'出社時刻と退社時刻を比較します
            If Cells(i, 4) > Cells(i, 5) Then
                Cells(i, 5).Select
                rR = Selection.Row
                rC = Selection.Column
                MsgBox "Cell( " & rR & " , " & rC & " )" & _
                    " で出社時刻前に退社しています。" & vbCrLf & _
                    "24時間表示で入力してください。", vbExclamation, _
                    "時給計算表作成"
                Exit Sub
            End If
'出社時刻と退社時刻の入力があるものだけ計算します
            If Cells(i, 4) <> "" And Cells(i, 5) <> "" Then
                Cells(i, 7) = Cells(i, 5) - Cells(i, 4) - Cells(i, 6)
            End If
'基準時間と実労時間が表示されているものだけ計算します
            If Cells(i, 3) <> "" And Cells(i, 7) <> "" Then
                Cells(i, 8) = Cells(i, 7) - Cells(i, 3)
                Cells(i, 8).Select
'時間外時間がマイナスの場合は空欄にします
                If Cells(i, 8) < 0 Then
                    Cells(i, 8) = ""
                End If
            End If
        Next i
'合計欄の表示形式の設定
        With Range("C32:H32")
            .NumberFormatLocal = "[h]:mm;@"
            .Font.Bold = True
        End With
    Exit Sub
        
'エラー時のジャンプ先
step_err:
        rR = r.Row
        rC = r.Column
        MsgBox "Cell( " & rR & " , " & rC & " )" & _
            " で時刻（分）表示が違います", vbExclamation, _
            "時給計算表作成"
End Sub