支給金額合計と時間・金額マルメ計算のVBAコード

時給計算表で支給金額合計の計算方法です。日給合計とマルメ計算方法の紹介をいたします。時間マルメの方法は要チェックです。
これで、時給計算表の計算関係のコードは完了になります。

こんにちは、じゅんぱ店長（@junpa33）です。

今回は、支給金額決定のための日給の合計とマルメを計算するVBAコードの組み立て方になります。

時給計算表作成の記事編成

時給計算表作成エクセルソフトの使い方とダウンロード
- 時給計算表エクセルソフト無料ダウンロードと取り扱い説明

時給計算表作成エクセルソフトの作成手順

コンテンツ

支給金額合計と時間・金額マルメ計算の表示例

今回の紹介内容は、時給計算表の合計欄の部分とマルメ表示部分になります。

赤枠表示の部分についてです。

目次へ戻る

日給金額を合計するVBAコード

はじめに、日給金額を合計するVBAコードを組み立てて行きます。

今回のエクセルVBAコードは「module2」に記述していきます。

その前にパブリック変数とその代入プロシージャーを確認

最初に、

今から組み立てるプロシージャーに対しても、このVBAコードで指定している変数を使用するので、確認しておきます。

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

VBA

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

これはすでにModule1で記述しているコードです。

今回も再度記述する必要はありません。

合計計算で作成するVBA全コード

VBA

Sub 合計計算()
    Dim Sh As Worksheet
    Dim res As Boolean
    Dim Vs As Long, Vss As Long
    Dim Vt As Long, Vtt As Long
        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
        With ThisWorkbook.Worksheets(EmpName & "時給計算表")
'計算日数合計を表示します
            .Range("B32") = "日数合計 " & BRow - 2 & "日"
'基準時間の合計時間を計算します
            .Range("C32") = WorksheetFunction.Sum(Range("C3:C31"))
'休憩時間の合計時間を計算します
            .Range("F32") = WorksheetFunction.Sum(Range("F3:F31"))
'実労時間の合計時間を計算します
            .Range("G32") = WorksheetFunction.Sum(Range("G3:G31"))
'時間外時間の合計時間を計算します
            .Range("H32") = WorksheetFunction.Sum(Range("H3:H31"))
'合計支給金額を計算します
            .Range("I32") = WorksheetFunction.Sum(.Range("I3:I31"))
            .Range("J32") = WorksheetFunction.Sum(.Range("J3:J31"))
            .Range("K32") = WorksheetFunction.Sum(.Range("K3:K31"))
        End With
End Sub

合計計算のVBA　ポイント説明

パブリック変数への代入値を取得

2022年4月17日部品化プロシージャーでCallステートメントは必須

先に説明したプロシージャーを呼び出し変数への代入値を取得します。

対象者時給計算表テンプレートシートの存在確認

2022年7月9日シートの存在を確認する2種類のコードと実務での例題

'計算するシートが存在するかを調べる
        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

「対象者時給計算表テンプレートシート」が存在しない場合はプロシージャーを終了します。

列項目の合計を計算

時間の合計計算をするには、ここでも「SUM関数」を利用します。

「SUM関数」についてはこちらの記事を参考にしてください。

2020年12月9日 SUM関数で合計計算！実務で使えるVBAコード作成

目次へ戻る

マルメ計算のVBAコード

マルメ計算のコードを組み立てて行きます。

パブリック変数と代入プロシージャーの確認

先ほどと同様にこのコードを設置しておきます。

宣言セクションと設定値代入コードで、確認してください。

マルメ計算で作成するVBA全コード

VBA

Sub マルメ計算()
    Dim Sh As Worksheet
    Dim res As Boolean
    Dim Vxa As Long, Vza As Long
    Dim Vxb As Long, Vzb As Long
    Dim LVM As Long
        Call Module1.設定値代入
'時間外割増率が空欄の時100%とします
        If TwCos = "" Then TwCos = 100
'時間マルメが空欄の時は0とします
        If TMal = "" Then TMal = 0
'計算するシートが存在するかを調べます
        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
'時間マルメ実労時間について
'--マルメを設定しているとき
        If TMal <> 0 Then
'--マルメの「分」を計算
            Vxa = WorksheetFunction.RoundUp(Minute(Range("G32")) _
                / TMal, 0) * TMal
'--実労分からの差分を計算
            Vza = Vxa - Minute(Range("G32"))
'--マルメ時間を表示する
            Range("G34") = DateAdd("n", Vza, Range("G32"))
'時間マルメ時間外時間について
'--マルメの「分」を計算
            Vxb = WorksheetFunction.RoundUp(Minute(Range("H32")) _
                / TMal, 0) * TMal
'--時間外分からの差分を計算
            Vzb = Vxb - Minute(Range("H32"))
'--マルメ時間を表示する
            Range("H34") = DateAdd("n", Vzb, Range("H32"))
'--マルメを設定しないとき
        Else
            Range("G34") = Range("G32")
            Range("H34") = Range("H32")
        End If
'時間マルメまでの支給額合計を計算
        LVM = Range("G34") * 24 * TCos + Range("H34") * 24 * _
            TCos * TwCos
'金額マルメで支給金額を決定
'--切り上げしない
        If KMal = 0 Or KMal = "" Then
            Range("F34") = "マルメなし"
            Range("I34") = LVM
'--1円以下を切り上げ
        ElseIf KMal = 1 Then
            Range("F34") = "10円単位"
'--1桁を小数点以下にする
            Range("I34") = WorksheetFunction.RoundUp(LVM _
                / 10, 0) * 10
'--10円以下を切り上げ
        ElseIf KMal = 2 Then
            Range("F34") = "100円単位"
'--2桁を小数点以下にする
            Range("I34") = WorksheetFunction.RoundUp(LVM _
                / 100, 0) * 100
'--100円以下を切り上げ
        ElseIf KMal = 3 Then
            Range("F34") = "1000円単位"
'--3桁を小数点以下にする
            Range("I34") = WorksheetFunction.RoundUp(LVM _
                / 1000, 0) * 1000
        Else
            Range("F34") = "マルメなし"
            Range("I34") = LVM
        End If
End Sub