【Excel VBA】出退勤打刻ツール：出退勤時間の打刻と給与算出

■ツール概要と目的

Excel VBAを使用して、アルバイトや社員の出勤および退勤時間を打刻する。
出退勤時間から、勤務時間を算出し、給与（日給）も算出する。

以降、本ツールを「出退勤打刻ツール」と呼ぶ。

■機能設計

本項では、「出退勤打刻ツール」の機能概要を示す。

▼機能フロー図

ユーザが使用する観点での機能フロー図を以下に示す。

▼機能概要

「▼機能フロー図」に基づく、機能概要を以下表に示す。

▼入出力一覧

「▼機能フロー図」に基づく、入出力一覧を以下表に示す。

▼画面仕様

「出退勤打刻ツール」に関する画面仕様を示す。

・「main」シート

「出退勤打刻ツール」で主として使用するシート。

・「フォーマット」シート

各社員の出退勤情報を出力する際のフォーマット。

・「＜社員番号＞」シート

「フォーマット」シートを＜社員番号＞でコピーし、出退勤情報を出力するシート。

▼制限事項・前提条件

「出退勤打刻ツール」を作成するにあたり、以下の条件を前提として実装する。

• 深夜時間帯の勤務は発生しないものとする（22時以降の勤務なし）。
• 日跨ぎの勤務は、なしとする。
• 休憩時間は、6時間未満ならば30分6時間以上なら1時間とする。
• 勤務時間の単位は時間のみで少数は第１位までとする。
• 時給は1200円固定とする。

■プログラム設計

本項では、「出退勤打刻ツール」のプログラム仕様について示す。

▼各処理の概要

「出退勤打刻ツール」で使用する処理概要を以下に示す。

▼メイン処理

「main」シートの「打刻」ボタン押下時の処理を「メイン処理」とする。
「出勤」および「退勤」の選択に応じて、処理を分岐する。

・プログラム処理フロー図

「メイン処理」のプログラム処理フロー図を以下に示す。

・プログラム仕様

「メイン処理」のプログラム仕様を以下の表に示す。

▼社員存在確認処理

インプットボックスに入した社員番号の名前のシート名が存在するか確認する処理。

・プログラム処理フロー図

「社員存在確認処理」のプログラム処理フロー図を以下に示す。

・プログラム仕様

「社員存在確認処理」のプログラム仕様を以下の表に示す。

▼シート新規作成処理

インプットボックスに入した社員番号の名前のシートを末尾に新規作成する。

・プログラム処理フロー図

「シート新規作成処理」のプログラム処理フロー図を以下に示す。

・プログラム仕様

「シート新規作成処理」のプログラム仕様を以下の表に示す。

▼フォーマット初期化処理

「フォーマット」シートの記載内容を「社員番号」シートにコピーする。
「社員番号」シートに「社員番号」および「社員名」を出力する。

・プログラム処理フロー図

「フォーマット初期化処理」のプログラム処理フロー図を以下に示す。

・プログラム仕様

「シート新規作成処理」のプログラム仕様を以下の表に示す。

▼出勤処理

「社員番号」シートに「打刻」ボタン押下時の日付と出勤時間を出力する。
すでに出勤していた場合は、上書きするか確認する。

・プログラム処理フロー図

「出勤処理」のプログラム処理フロー図を以下に示す。

・プログラム仕様

「出勤処理」のプログラム仕様を以下の表に示す。

▼退勤処理

「社員番号」シートに「打刻」ボタン押下時の退勤時間を出力する。
出勤時間と退勤時間から給与（日給）を算出する。
すでに退勤していた場合は、上書きする。

・プログラム処理フロー図

「退勤処理」のプログラム処理フロー図を以下に示す。

・プログラム仕様

「退勤処理」のプログラム仕様を以下の表に示す。

■サンプルコード

「出退勤打刻ツール」のソースコードを以下に記載する。
なお、ソースは「ThisWorkbook」にすべて記載する（図の赤枠参照）。

Option Explicit

' シート名に関する定数
Private Const SHEETNAME_MAIN As String = "main"
Private Const SHEETNAME_FORMAT As String = "フォーマット"

' セル範囲の定数
Private Const RANGE_FORMAT As String = "A1:H36" ' コピペ範囲
Private Const COLUMNS_FORMAT As String = "B:H"  ' 列幅自動調整範囲

' 「社員番号」シートに関する定数
Private Const SYAIN_CODE_ROW As Integer = 2         ' 社員番号入力行
Private Const SYAIN_NAME_ROW As Integer = 3         ' 社員名入力行
Private Const SYAIN_INFO_COL As Integer = 3         ' 社員情報入力列

Private Const START_DATA_ROW As Integer = 6         ' データ部開始行
Private Const START_DATA_COL As Integer = 2         ' データ部開始列（日付）
Private Const START_WORK_COL As Integer = 3         ' 出勤時間列
Private Const END_WORK_COL As Integer = 4           ' 退勤時間列
Private Const TOTAL_WORK_TIME_COL As Integer = 5    ' 総時間列
Private Const REST_TIME_COL As Integer = 6          ' 休憩時間列
Private Const WORK_TIME_COL As Integer = 7          ' 勤務時間列
Private Const SALARY_COL As Integer = 8             ' 給与列

Private Const JIKYU As Integer = 1200               ' 時給

' メッセージに関する定数
Private Const MSG_INPUT_SYAINCODE As String = "社員番号を入力してください"
Private Const MSG_NON_INPUT_SYAINCODE As String = "社員番号が入力されていません"
Private Const MSG_NO_EXIST_SYAINCODE As String = "社員番号が存在しません"
Private Const MSG_IS_CREATE_NEW_SHEET As String = "新規作成しますか？"
Private Const MSG_PLEASE_CREATE_NEW_SHEET As String = "出勤を選択し、新規作成してください"
Private Const MSG_INPUT_SYAINNAME As String = "社員名を入力してください"
Private Const MSG_NON_INPUT_SYAINNAME As String = "社員名が入力されていません"
Private Const MSG_ERR_EXCEPTION As String = "例外エラー："
Private Const MSG_ALREADY_START_WORK As String = "すでに出勤していますが、上書きしますか？"
Private Const MSG_NO_SYUKKIN_DATA As String = "出勤の打刻がありません"


' 「打刻」ボタン押下時の処理（メイン処理）
Public Sub Click_DakokuBtn()
    Dim sht_main As Worksheet       ' mainシート格納変数
    Dim syain_code As String        ' 社員番号
    Dim is_shukkin As Boolean       ' 出勤判定
    Dim is_taikin As Boolean        ' 退勤判定
    Dim exist_sheet_flg As Integer  ' シートに社員番号が存在するかフラグ
    Dim yes_no_result As Long       ' yes/noのMsgBox戻り値格納
    Dim syain_name As String        ' 社員名
    
    On Error GoTo Click_DakokuBtn_err
    
    ' mainシートセット
    Set sht_main = ThisWorkbook.Sheets(SHEETNAME_MAIN)
    
    ' 出勤/退勤のラジオボタンの値取得
    is_shukkin = ThisWorkbook.Sheets(SHEETNAME_MAIN).shukkin_radiobtn.Value
    is_taikin = ThisWorkbook.Sheets(SHEETNAME_MAIN).taikin_radiobtn.Value
    
    ' インプットボックス：社員番号
    syain_code = InputBox(MSG_INPUT_SYAINCODE)
    
    ' インプットボックス：空文字の場合
    If syain_code = "" Then
        
        ' 警告メッセージ出力
        MsgBox MSG_NON_INPUT_SYAINCODE
        
        ' 終了処理へ
        GoTo Click_DakokuBtn_exit
        
    End If
    
    ' 社員存在確認処理呼び出し
    exist_sheet_flg = chk_exit_sheet(syain_code)
    
    ' 社員番号が存在する場合
    If exist_sheet_flg = 1 Then
    
        ' 出勤の場合
        If is_shukkin Then
            ' 出勤処理呼び出し
            Call dakoku_shukkin(syain_code)
        
        ' 退勤の場合
        ElseIf is_taikin Then
            ' 退勤処理呼び出し
            Call dakoku_taikin(syain_code)
            
        End If
        
    ' 社員番号が存在しない & 出勤の場合
    ElseIf exist_sheet_flg = 0 And is_shukkin Then
        
        ' 新規作成するかメッセージ出力（Yes/No）
        yes_no_result = MsgBox(MSG_NO_EXIST_SYAINCODE & vbCrLf _
            & MSG_IS_CREATE_NEW_SHEET, vbYesNo)
        
        ' 「Yes」を選択の場合
        If yes_no_result = vbYes Then
            
            ' 社員名をインプットボックスで入力
            syain_name = InputBox(MSG_INPUT_SYAINNAME)
            
            ' インプットボックス：空文字の場合
            If syain_name = "" Then
        
                ' 警告メッセージ出力
                MsgBox MSG_NON_INPUT_SYAINNAME
        
                ' 終了処理へ
                GoTo Click_DakokuBtn_exit
        
            End If
            
            ' ワークシート新規作成処理呼び出し
            Call make_new_sheet(syain_code)
            
            ' フォーマット初期設定処理呼び出し
            Call make_format(syain_code, syain_name)
            
            ' 出勤処理呼び出し
            Call dakoku_shukkin(syain_code)
            
        End If
    
    ' 社員番号が存在しない & 退勤の場合
    ElseIf exist_sheet_flg = 0 And is_taikin Then
        
        ' 警告メッセージ出力
        MsgBox MSG_NO_EXIST_SYAINCODE & vbCrLf & MSG_PLEASE_CREATE_NEW_SHEET
    
    End If
    
    ' 終了処理へ
    GoTo Click_DakokuBtn_exit

' 例外処理
Click_DakokuBtn_err:
    
    ' 例外エラーメッセージ出力
    MsgBox MSG_ERR_EXCEPTION & "Click_DakokuBtn" _
        & vbCrLf & Err.Description

    ' 終了処理へ
    GoTo Click_DakokuBtn_exit

' 終了処理
Click_DakokuBtn_exit:

    ' worksheet解放
     Set sht_main = Nothing
    
End Sub


' 社員存在確認処理
Private Function chk_exit_sheet(code As String) As Integer

    Dim sht As Worksheet    ' worksheetオブジェクト格納
    
    ' 戻り値の初期値をセット
    chk_exit_sheet = 0
    
    ' シート分繰り返し
    For Each sht In ThisWorkbook.Worksheets
        
        ' シート名に社員番号が存在した場合
        If code = sht.Name Then
            
            ' 戻り値「1」をセット
            chk_exit_sheet = 1
        
        End If
    
    Next
        
End Function

' シート作成処理
Private Sub make_new_sheet(code As String)

    Dim sht_count As Long   ' シートカウンタ
    
    ' シート数取得
    sht_count = ThisWorkbook.Worksheets.Count
        
    ' ワークシートをシートの末尾に新規作成
    ThisWorkbook.Worksheets.Add after:=Worksheets(sht_count)
    
    ' シート名を社員番号に変更
    ThisWorkbook.Worksheets(sht_count + 1).Name = code

End Sub

' フォーマット初期設定処理
Private Sub make_format(code As String, s_name As String)

    Dim sht_format As Worksheet     ' 「フォーマット」シート格納変数
    Dim sht_syaincode As Worksheet  ' 「社員番号」シート格納変数

    On Error GoTo make_format_err
    
    ' 「フォーマット」シートをセット
    Set sht_format = ThisWorkbook.Sheets(SHEETNAME_FORMAT)
    ' 「社員番号」シートをセット
    Set sht_syaincode = ThisWorkbook.Sheets(code)
    
    ' 「フォーマット」シートにフォーカス
    With sht_format
        
        ' 「フォーマット」の内容を「社員番号」シートにコピー
        .Range(RANGE_FORMAT).Copy _
            Destination:=sht_syaincode.Range(RANGE_FORMAT)
    
    End With
    
    ' 「社員番号」シートにフォーカス
    With sht_syaincode
        
        ' 社員番号と社員名を出力
        .Cells(SYAIN_CODE_ROW, SYAIN_INFO_COL).Value = code
        .Cells(SYAIN_NAME_ROW, SYAIN_INFO_COL).Value = s_name
        
        ' セルの列幅を自動調整
        .COLUMNS(COLUMNS_FORMAT).AutoFit
    
    End With
    
    ' 終了処理へ
    GoTo make_format_exit

' 例外処理
make_format_err:

    ' 例外エラーメッセージ出力
    MsgBox MSG_ERR_EXCEPTION & "make_format" _
        & vbCrLf & Err.Description
    
    ' 終了処理へ
    GoTo make_format_exit

' 終了処理
make_format_exit:
    ' シートの解放
    Set sht_format = Nothing
    Set sht_syaincode = Nothing

End Sub

' 出勤処理
Private Sub dakoku_shukkin(code As String)

    Dim sht_syaincode As Worksheet  ' 「社員番号」シート格納変数
    Dim i_row As Integer            ' 行カウンタ
    Dim yes_no_chk As Long          ' yes/no判定結果格納変数
    
    On Error GoTo dakoku_shukkin_err
    
    ' 「社員番号」シートをセット
    Set sht_syaincode = ThisWorkbook.Sheets(code)
    
    ' 行カウンタの初期値セット
    i_row = START_DATA_ROW
    
    ' 「社員番号」シートにフォーカス
    With sht_syaincode
        ' 日付の値が空になるまで繰り返し
        Do While .Cells(i_row, START_DATA_COL).Value <> ""
            
            ' すでに出勤していた場合
            If .Cells(i_row, START_DATA_COL).Value = Date Then
                ' 警告メッセージ出力
                yes_no_chk = MsgBox(MSG_ALREADY_START_WORK, vbYesNo)
                
                ' 上書きする場合
                If yes_no_chk = vbYes Then
                    
                    ' 出勤時間列に現在時刻を出力
                    .Cells(i_row, START_WORK_COL).Value = Format(Now, "Short Time")
                    
                    ' 退勤に関連する処理を初期化
                    .Cells(i_row, END_WORK_COL).Value = ""
                    .Cells(i_row, TOTAL_WORK_TIME_COL).Value = ""
                    .Cells(i_row, REST_TIME_COL).Value = ""
                    .Cells(i_row, WORK_TIME_COL).Value = ""
                    .Cells(i_row, SALARY_COL).Value = ""
                    
                    ' セルの列幅を自動調整
                    .COLUMNS(COLUMNS_FORMAT).AutoFit
                    
                    ' 終了処理へ
                    GoTo dakoku_shukkin_exit
                
                End If
            
            End If
            
            ' 行カウンタをインクリメント
            i_row = i_row + 1
            
        Loop
        
        ' 今日日付を出力
        .Cells(i_row, START_DATA_COL).Value = Date
        ' 出勤時間に現在時刻を出力
        .Cells(i_row, START_WORK_COL).Value = Format(Now, "Short Time")
        
        ' 退勤に関連する処理を初期化
        .Cells(i_row, END_WORK_COL).Value = ""
        .Cells(i_row, TOTAL_WORK_TIME_COL).Value = ""
        .Cells(i_row, REST_TIME_COL).Value = ""
        .Cells(i_row, WORK_TIME_COL).Value = ""
        .Cells(i_row, SALARY_COL).Value = ""
        
        ' セルの列幅を自動調整
        .COLUMNS(COLUMNS_FORMAT).AutoFit
    
    End With
    
    ' 終了処理へ
    GoTo dakoku_shukkin_exit

' 例外処理
dakoku_shukkin_err:

    ' 例外エラーメッセージ出力
    MsgBox MSG_ERR_EXCEPTION & "dakoku_shukkin" _
        & vbCrLf & Err.Description
    
    ' 終了処理へ
    GoTo dakoku_shukkin_exit

' 終了処理
dakoku_shukkin_exit:
    ' シートオブジェクトの解放
    Set sht_syaincode = Nothing
    
End Sub

' 退勤処理
Private Sub dakoku_taikin(code As String)

    Dim sht_syaincode As Worksheet  ' 「社員番号」シート格納変数
    Dim i_row As Integer            ' 行カウンタ
    Dim yes_no_chk As Long          ' yes/no判定結果格納変数
    
    On Error GoTo dakoku_taikin_err
    
    ' 「社員番号」シートをセット
    Set sht_syaincode = ThisWorkbook.Sheets(code)
    
    ' 行カウンタの初期値セット
    i_row = START_DATA_ROW

    ' 「社員番号」シートにフォーカス
    With sht_syaincode
        ' 日付の値が空になるまで繰り返し
        Do While .Cells(i_row, START_DATA_COL).Value <> ""
            ' 日付が存在する & 出勤の打刻がされている場合
            If .Cells(i_row, START_DATA_COL).Value = Date _
                And .Cells(i_row, START_WORK_COL).Value <> "" Then
                
                ' 退勤時刻を出力（現在時刻）
                .Cells(i_row, END_WORK_COL).Value = Format(Now, "Short Time")
                
                ' 総時間を出力（単位：時間）
                .Cells(i_row, TOTAL_WORK_TIME_COL).Value = _
                    (.Cells(i_row, END_WORK_COL).Value - .Cells(i_row, START_WORK_COL).Value) * 24
                    
                ' 総時間が6時間未満の場合
                If .Cells(i_row, TOTAL_WORK_TIME_COL).Value < 6 Then
                    ' 休憩時間は30分（0.5時間）
                    .Cells(i_row, REST_TIME_COL).Value = 0.5

                ' 6時間以上の場合
                Else
                    ' 休憩時間は1時間
                    .Cells(i_row, REST_TIME_COL).Value = 1
                
                End If
                
                ' 勤務時間を出力
                .Cells(i_row, WORK_TIME_COL).Value = _
                    .Cells(i_row, TOTAL_WORK_TIME_COL).Value - .Cells(i_row, REST_TIME_COL).Value
                
                ' 給与を出力
                .Cells(i_row, SALARY_COL).Value = _
                    .Cells(i_row, WORK_TIME_COL).Value * JIKYU
                
                ' セルの列幅を自動調整
                .COLUMNS(COLUMNS_FORMAT).AutoFit
                
                ' 終了処理へ
                GoTo dakoku_taikin_exit
                
            End If
            
            ' 行カウンタをインクリメント
            i_row = i_row + 1
            
        Loop

    End With
    
    ' 対象の日付が存在しない場合は、警告メッセージ出力
    MsgBox MSG_NO_SYUKKIN_DATA
    
    ' 終了処理へ
    GoTo dakoku_taikin_exit

' 例外処理
dakoku_taikin_err:

    ' 例外エラーメッセージ出力
    MsgBox MSG_ERR_EXCEPTION & "dakoku_taikin" _
        & vbCrLf & Err.Description
    
    ' 終了処理へ
    GoTo dakoku_taikin_exit

' 終了処理
dakoku_taikin_exit:
    ' シートオブジェクトの解放
    Set sht_syaincode = Nothing

End Sub

■実行結果

「出退勤打刻ツール」の正常系操作および異常系操作について、実行結果を以下に示す。

▼正常系

正常系の処理については、「出勤（新規社員）」、「出勤（既存社員）」、「退勤（既存社員）」について示す。

・出勤（新規社員）

ラジオボタンの「出勤」を選択し、「打刻」ボタンを押下する。

インプットボックスに社員番号「123456」を入力し、「OK」ボタンを押下する。

確認メッセージに対して、「はい(Y)」を押下する。

インプットボックスに社員名「AAA」を入力し、「OK」ボタンを押下する。

社員番号「123456」および社員名「AAA」が反映され、日付列および出勤時間列に現在日時が出力されることを確認。

・出勤（既存社員）

ラジオボタンの「出勤」を選択し、「打刻」ボタンを押下する。

インプットボックスに既存の社員番号「1324568」を入力し、「OK」ボタンを押下する。

既存の社員番号「1324568」に対して、日付および出勤時刻に現在日時が追記されることを確認。

・退勤処理（既存社員）

ラジオボタンの「退勤」を選択し、「打刻」ボタンを押下する。

インプットボックスに社員番号「123456」を入力し、「OK」ボタンを押下する。

以下の項目について確認する（図の赤枠部分）。

• 「退勤時間」に現在時刻が出力されること。
• 「総時間」が出力されること。
• 「休憩」が出力されること。
• 「勤務時間」が出力されること。
• 「給与」が出力されること。

▼異常系

異常系操作については、複数存在するため、ここでは、「出勤時の社員番号未入力」および「社員番号未登録の退勤処理」について示す。

・出勤時の社員番号未入力

ラジオボタンの「出勤」を選択し、「打刻」ボタンを押下する。
インプットボックスには、何も記入せずに「OK」ボタンを押下する。

「社員番号が入力されていません」のメッセージが出力されることを確認。

・社員番号未登録の退勤処理

ラジオボタンの「退勤」を選択し、「打刻」ボタンを押下する。
インプットボックスには、存在しない社員番号「1111111」を入力する。

「社員番号が存在しません 出勤を選択し、新規作成してください」のメッセージが出力されることを確認。