勤務時間と時給から日給計算する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 i As Long
    Dim Va As Long, Vb As Long
    Dim Vaa As Long, Vbb As Long
    Dim B32V As String
        Call Module1.設定値代入
'時間外割増率が空欄の時100%とします
        If TwCos = "" Then TwCos = 100
'計算するシートが存在するかを調べる
        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
        ThisWorkbook.Worksheets(EmpName & "時給計算表").Select
'記入データ行数を調べます
        B32V = Range("B32")
        Range("B32") = ""
        BRow = Cells(Rows.Count, 2).End(xlUp).Row
        Range("B32") = B32V
        For i = 3 To BRow
'初期値にリセットします
            Vaa = 0
            Vbb = 0
            Va = 0
            Vb = 0
'時間外時間が発生しているかどうかで区別します
            If Cells(i, 8) > 0 Then
                Vaa = Cells(i, 3) * 24 * TCos
'値を切り上げ（小数点を切り上げ）
                Va = WorksheetFunction.RoundUp(Vaa, 0)
                Vbb = Cells(i, 8) * 24 * TCos * TwCos
'値を切り上げ（小数点を切り上げ）
                Vb = WorksheetFunction.RoundUp(Vbb, 0)
            Else
                Vaa = Cells(i, 7) * 24 * TCos
'値を切り上げ（小数点を切り上げ）
                Va = WorksheetFunction.RoundUp(Vaa, 0)
            End If
'支給金額の表示します
            Cells(i, 9) = Va + Vb
'参考金額を表示します
            Cells(i, 10) = Va
            Cells(i, 11) = Vb
'金額マルメ計算
            If KMal = 1 Then
'1円以下を切り上げ
                Cells(i, 9) = WorksheetFunction.RoundUp(Cells(i, 9) _
                    / 10, 0) * 10
            ElseIf KMal = 2 Then
'10円以下を切り上げ
                Cells(i, 9) = WorksheetFunction.RoundUp(Cells(i, 9) _
                    / 100, 0) * 100
            ElseIf KMal = 3 Then
'100円以下を切り上げ
                Cells(i, 9) = WorksheetFunction.RoundUp(Cells(i, 9) _
                    / 1000, 0) * 1000
            Else
'切り上げしない
                Cells(i, 9) = Va + Vb
            End If
        Next i
End Sub