勤務管理表 [コンピューター]
エクセルで作成した勤務管理表について整理します。
【エクセルシート】
・A2-A32セル：日を表示します。表示形式は"d"です。
A2セル：その月の1日を「yyyy/mm/dd」の形式で入力します。例えば「2014/7/1」のように。
A3セル：「=A2+1」の式が入っています。2日を表します。
｜
A32セル：「=A31+1」の式が入っています。31日を表します。
・B2-B32セル：曜日を表示します。表示形式は"aaa"です。
日曜日のセルをピンクで塗るため、=TEXT(A2,"aaa")="日"の条件付き書式を設定しています。
土曜日のセルを水色で塗るため、=TEXT(A2,"aaa")="土"の条件付き書式を設定しています。
B2セル：「=A2」の式が入っています。1日の曜日を表します。
B3セル：「=A3」の式が入っています。2日の曜日を表します。
｜
B32セル：「=A32」の式が入っています。31日の曜日を表します。
・C2-C32セル：出社時刻を入力します。表示形式は"h:mm"です。
・D2-D32セル：退社時刻を入力します。表示形式は"h:mm"です。
"0:00"から"8:30"までの時刻を入力した場合、翌日退社扱いとなります。
・E2-E32セル：作業時間(60進)を表示します。
・名前："作業時間"
・表示形式："h:mm"
・F2-F32セル：作業時間(10進)を表示します。表示形式は"0.00"です。
・G2-G32セル：残業時間(60進)を表示します。表示形式は"h:mm"です。
・H2-H32セル：深夜時間(60進)を表示します。
・名前："深夜時間"
・表示形式："h:mm"
・E33セル：(A)作業時間(60進)の合計を表示します。
・式：=SUM(E2:E32)
・表示形式：[h]:mm
・F33セル：(B)作業時間(10進)の合計を表示します。
・式：=SUM(F2:F32)
・表示形式：0.00
・G33セル：(C)残業時間(60進)の合計を表示します。
・式：=SUM(G2:G32)
・表示形式：[h]:mm
・H33セル：(D)深夜時間(60進)の合計を表示します。
・式：=SUM(H2:H32)
・表示形式：[h]:mm
・E37セル：昼休みの開始時刻をリストから選択します。
・名前："昼休開始"
・元の値：=$G$37:$H$37
・E38セル：残業の開始時刻をリストから選択します。
・名前："残業開始"
・元の値：=$G$38:$H$38
・E39セル：深夜残業の開始時刻をリストから選択します。
・名前："深夜開始"
・元の値：=$G$39
・J2セル：年月を表示します。
・表示形式：yyyy"年"m"月"
・式：=A2
・L3セル：(E)作業日数を表示します。
・式：=COUNTA(作業時間)
・L4セル：(E)作業日数に7.75h(1日の標準作業時間)を掛けた値(F)を計算します。24で割っているのは10進⇒60進変換のため(エクセルは24hを1とするシリアル値で時間を管理しているため)。
・表示形式：[h]:mm
・式：=L3*7.75/24
・L5セル：(A)から(F)を引いた値(G)を表示します。(C)残業時間と同じ値になります。
・表示形式：[h]:mm
・式：=E33-L4
・L6セル：(H)深夜日数を表示します。
・式：=COUNTA(深夜時間)
【マクロ】
・出社時刻、退社時刻が入力されたら、マクロを自動起動します。
・出社時刻、退社時刻は、時刻のみ入力します。24:00以降に退社しても計算できるように、
・出社時刻：2014年4月1日を足す。
・退社時刻：2014年4月1日を足す。但し、0:00から8:30までの場合、さらに1日足して2014年4月2日とする。
として、作業時間、残業時間、深夜時間を計算します。
・コード
' このマクロはシートに置くこと
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("出社退社")) Is Nothing Then
' 変化が無ければ抜ける
Exit Sub
Else
' 画面更新の停止
Application.ScreenUpdating = False
' 変数の定義
Dim Time1(20) As Date ' 時刻シリアル値（定義時刻）
Dim Time2(10) As Date ' 時刻シリアル値（出社時刻、退社時刻）
Dim Time4(10) As Date ' 時刻シリアル値（昼休時刻、残業開始）
Dim n As Integer ' 整数
Dim i As Integer ' 整数
n = 32 ' 31日の行番号
' n = Cells(Rows.Count, "A").End(xlUp).Row ' A列の最終日の行
' 時刻定義
Time1(0) = DateSerial(2014, 4, 1) ' 2014年4月1日
Time1(1) = Time1(0) + TimeSerial(0, 0, 0) ' 2014年4月1日 0時0分
Time1(2) = Time1(0) + TimeSerial(8, 30, 0) ' 2014年4月1日 8時30分
Time1(3) = Time1(0) + TimeSerial(11, 45, 0) ' 2014年4月1日 11時45分
Time1(4) = Time1(0) + TimeSerial(12, 0, 0) ' 2014年4月1日 12時0分
Time1(5) = Time1(0) + TimeSerial(12, 45, 0) ' 2014年4月1日 12時45分
Time1(6) = Time1(0) + TimeSerial(13, 0, 0) ' 2014年4月1日 13時0分
Time1(7) = Time1(0) + TimeSerial(17, 15, 0) ' 2014年4月1日 17時15分
Time1(8) = Time1(0) + TimeSerial(17, 30, 0) ' 2014年4月1日 17時30分
Time1(9) = Time1(0) + TimeSerial(18, 30, 0) ' 2014年4月1日 18時30分
Time1(10) = Time1(0) + TimeSerial(19, 0, 0) ' 2014年4月1日 19時0分
Time1(11) = Time1(0) + TimeSerial(21, 30, 0) ' 2014年4月1日 21時30分
Time1(12) = Time1(0) + TimeSerial(22, 0, 0) ' 2014年4月1日 22時0分
Time1(13) = DateSerial(2014, 4, 2) ' 2014年4月2日
Time1(14) = Time1(13) + TimeSerial(2, 15, 0) ' 2014年4月2日 2時15分
Time1(15) = Time1(13) + TimeSerial(2, 45, 0) ' 2014年4月2日 2時45分
Time1(16) = Time1(13) + TimeSerial(8, 15, 0) ' 2014年4月2日 8時15分
Time1(17) = Time1(13) + TimeSerial(8, 30, 0) ' 2014年4月2日 8時30分
' 昼休み時間の定義
Select Case Range("昼休開始").Value
Case TimeSerial(11, 45, 0)
Time4(0) = Time1(3) ' 昼休み開始(11:45)
Time4(1) = Time1(5) ' 昼休み終了(12:45)
Case TimeSerial(12, 0, 0)
Time4(0) = Time1(4) ' 昼休み開始(12:00)
Time4(1) = Time1(6) ' 昼休み終了(13:00)
Case Else
Time4(0) = Time1(4) ' 昼休み開始(12:00)
Time4(1) = Time1(6) ' 昼休み終了(13:00)
End Select
' 残業開始時刻の定義
Select Case Range("残業開始").Value
Case TimeSerial(17, 30, 0)
Time4(2) = Time1(8) ' 残業開始(17:30)
Case TimeSerial(19, 0, 0)
Time4(2) = Time1(10) ' 残業開始(19:00)
Case Else
Time4(2) = Time1(8) ' 残業開始(17:30)
End Select
' 作業時間の計算
For i = 2 To n ' 1日から31日まで
If IsEmpty(Cells(i, 3)) = False Then
' 出社時刻が入力されていれば、2014年4月1日を足す
Time2(0) = Time1(0) + Cells(i, 3).Value ' 出社時刻
End If
If IsEmpty(Cells(i, 4)) = False Then
' 退社時刻が入力されていれば、2014年4月1日を足す
Time2(1) = Time1(0) + Cells(i, 4).Value ' 退社時刻
' 退社時刻が「2014年4月1日 0時0分」から「2014年4月1日 8時30分」なら、1日ずらす（翌日退社）
If (Time2(1) >= Time1(1)) And (Time2(1) <= Time1(2)) Then
Time2(1) = DateAdd("d", 1, Time2(1))
Cells(i, 4).Font.ColorIndex = 3 ' 文字色を赤に
Else
Cells(i, 4).Font.ColorIndex = 1 ' 文字色を黒に
End If
End If
If (IsEmpty(Cells(i, 3)) = True) Or (IsEmpty(Cells(i, 4)) = True) Then
' 出社時刻 or 退社時刻のいずれかが空白なら、作業時間、残業時間、深夜時間に空白を代入
Cells(i, 5).Value = "" ' 作業時間(60進)(E列)
Cells(i, 6).Value = "" ' 作業時間(10進)(F列)
Cells(i, 7).Value = "" ' 残業時間(60進)(G列)
Cells(i, 8).Value = "" ' 深夜時間(60進)(H列)
ElseIf Time2(0) > Time2(1) Then
' 出社時刻>退社時刻だったら、作業時間に空白を代入
Cells(i, 5).Value = "" ' 作業時間(60進)(E列)
Cells(i, 6).Value = "" ' 作業時間(10進)(F列)
Cells(i, 7).Value = "" ' 残業時間(60進)(G列)
Cells(i, 8).Value = "" ' 深夜時間(60進)(H列)
MsgBox "出社時刻>退社時刻(" & i - 1 & "日[" & i & "行目])"
Else
' 作業時間、残業時間、深夜時間の代入
' 作業時間(E, F列)
If mySagyouTime1(Time1, Time2, Time4) <> 0 Then
Cells(i, 5).Value = mySagyouTime1(Time1, Time2, Time4)
Cells(i, 6).Value = mySagyouTime1(Time1, Time2, Time4) * 24
Else
Cells(i, 5).Value = ""
Cells(i, 6).Value = ""
End If
' 残業時間(G列)
If myZangyouTime1(Time1, Time2, Time4) <> 0 Then
Cells(i, 7).Value = myZangyouTime1(Time1, Time2, Time4)
Else
Cells(i, 7).Value = ""
End If
' 深夜時間(H列)
If myShinyaTime1(Time1, Time2) <> 0 Then
Cells(i, 8).Value = myShinyaTime1(Time1, Time2)
Else
Cells(i, 8).Value = ""
End If
' 【注】
' 作業時間合計のセルの表示形式を「[hh]:mm」にしておくこと。
' [hh]としておくことで、24以上の時間を表示できる。
End If
Next i
' セルに色を塗る
Call Iro1
' 画面更新の再開
Application.ScreenUpdating = True
End If
End Sub
' 作業時間を算出
Function mySagyouTime1(ByRef Time1() As Date, ByRef Time2() As Date, _
ByRef Time4() As Date) As Date
Dim Time3 As Date ' 時刻シリアル値
Time3 = Time2(1) - Time2(0) ' 退社時刻 - 出社時刻
' 昼休み(11:45-12:45 or 12:00-13:00)
If Time2(0) <= Time4(0) Then
If Time2(1) >= Time4(1) Then
' 退社時刻 >= 昼休終了(12:45 or 13:00)
Time3 = Time3 - TimeSerial(1, 0, 0)
Else
' 退社時刻 < 昼休終了(12:45 or 13:00)
Time3 = Time3 - (Time2(1) - Time4(0))
End If
End If
' 休憩(17:15-17:30)
If Time2(0) <= Time1(7) And Time2(1) >= Time1(8) Then
Time3 = Time3 - TimeSerial(0, 15, 0)
End If
' 休憩(18:30-19:00)
If Time2(0) <= Time1(9) And Time2(1) >= Time1(10) Then
Time3 = Time3 - TimeSerial(0, 30, 0)
End If
' 休憩(21:30-22:00)
If Time2(0) <= Time1(11) And Time2(1) >= Time1(12) Then
Time3 = Time3 - TimeSerial(0, 30, 0)
End If
' 休憩(2:15-2:45)
If Time2(0) <= Time1(14) And Time2(1) >= Time1(15) Then
Time3 = Time3 - TimeSerial(0, 30, 0)
End If
' 休憩(8:15-8:30)
If Time2(0) <= Time1(16) And Time2(1) >= Time1(17) Then
Time3 = Time3 - TimeSerial(0, 15, 0)
End If
mySagyouTime1 = Time3
End Function
' 残業時間を算出
Function myZangyouTime1(ByRef Time1() As Date, ByRef Time2() As Date, _
ByRef Time4() As Date) As Date
Dim Time3(2) As Date ' 時刻シリアル値
' 残業の有無判定
Time3(1) = DateAdd("n", 15, Time4(2)) ' 残業開始15分後(17:45 or 19:15)
' 残業開始(17:30 or 19:00)から15分以上、勤務していたら残業ありと判定
If Time2(0) <= Time4(2) And Time2(1) >= Time3(1) Then
Time3(0) = Time2(1) - Time4(2) ' 残業時間（休憩時間含む）
' 休憩(18:30-19:00)
' 残業開始が19:00より前、かつ、出社が18:30以前、退社が19:00以降
If (Time4(2) < Time1(10)) And _
(Time2(0) <= Time1(9)) And (Time2(1) >= Time1(10)) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(21:30-22:00)
If Time2(0) <= Time1(11) And Time2(1) >= Time1(12) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(2:15-2:45)
If Time2(0) <= Time1(14) And Time2(1) >= Time1(15) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(8:15-8:30)
If Time2(0) <= Time1(16) And Time2(1) >= Time1(17) Then
Time3(0) = Time3(0) - TimeSerial(0, 15, 0)
End If
myZangyouTime1 = Time3(0)
Else
myZangyouTime1 = 0
End If
End Function
' 深夜時間を算出
Function myShinyaTime1(ByRef Time1() As Date, ByRef Time2() As Date) As Date
Dim Time3(1) As Date ' 時刻シリアル値
Time3(1) = DateAdd("n", 15, Time1(12)) ' 2014年4月1日 22時15分
' 22時0分から22時15分の間、勤務していたら深夜ありと判定
If Time2(0) <= Time1(12) And Time2(1) >= Time3(1) Then
Time3(0) = Time2(1) - Time1(12) ' 深夜時間（休憩時間含む）
' 休憩(2:15-2:45)
If Time2(0) <= Time1(14) And Time2(1) >= Time1(15) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(8:15-8:30)
If Time2(0) <= Time1(16) And Time2(1) >= Time1(17) Then
Time3(0) = Time3(0) - TimeSerial(0, 15, 0)
End If
myShinyaTime1 = Time3(0)
Else
myShinyaTime1 = 0
End If
End Function
' 作業時間、残業時間、深夜時間に着色する
Sub Iro1()
' 画面更新の停止
Application.ScreenUpdating = False
' 変数
Dim n As Integer ' 整数
Dim i, j As Integer ' 整数
Dim myRange(8) As Range
' myRange(0), myRange(1) : 作業時間(60進)あり/なし
' myRange(2), myRange(3) : 作業時間(10進)あり/なし
' myRange(4), myRange(5) : 残業時間(60進)あり/なし
' myRange(6), myRange(7) : 深夜時間(60進)あり/なし
Dim myFlag1() As Variant ' myRangeに値がsetされたら1になるフラグ
Dim mySelect As Range ' 選択されているセル
Dim myColor1() As Variant ' 色番号
myColor1() = Array(13434777, 13434777, 6750207, 6750207)
n = 32 ' 31日の行番号
' n = Cells(Rows.Count, "A").End(xlUp).Row ' A列の最終日の行
' 作業時間あり/なし、残業時間あり/なし、深夜時間あり/なしのmyRangeのフラグ
myFlag1() = Array(0, 0, 0, 0, 0, 0, 0, 0)
For i = 2 To n ' 1日から31日まで
' 作業時間(60進)(E列)、作業時間(10進)(F列)、残業時間(60進)(G列)、深夜時間(60進)(H列)の
' 各セルの値を調べて、myRangeに格納
For j = 0 To 3
Call myChkCell1(myRange(), myFlag1(), Cells(i, j + 5), j * 2)
Next j
' 現在選択されているセル
Set mySelect = Selection
' セルに色を塗る
For j = 0 To 3
Call SetIro1(myRange(), myFlag1(), j * 2, myColor1(j)) ' 時間あり
Call SetIro2(myRange(), myFlag1(), j * 2 + 1) ' 時間なし
Next j
' セル選択を元に戻す
mySelect.Select
Next i
' 画面更新の再開
Application.ScreenUpdating = True
End Sub
' 作業時間あり/なし、残業時間あり/なし、深夜時間あり/なしをセルごとに確認して、myRangeにセル番号を格納
Sub myChkCell1(ByRef myRange() As Range, ByRef myFlag1() As Variant, ByVal Cell1 As Range, ByVal No1 As Integer)
' myRange() : 作業時間あり/なし、残業時間あり/なし、深夜時間あり/なしのRange
' myFlag1() : myRangeに値がsetされたら1になるフラグ
' Cells1 : 値を確認するセルのRange
' No1 : myRange, myFlag1の添字
If Cell1.Value > 0 Then
' 時間あり(>0)
If myFlag1(No1) = 0 Then
Set myRange(No1) = Cell1 ' 1セル目をセット
myFlag1(No1) = 1 ' フラグをセット
Else
Set myRange(No1) = Union(myRange(No1), Cell1) ' 2セル目以降をセット
End If
Else
' 時間なし(=0)
If myFlag1(No1 + 1) = 0 Then
Set myRange(No1 + 1) = Cell1 ' 1セル目をセット
myFlag1(No1 + 1) = 1 ' フラグをセット
Else
Set myRange(No1 + 1) = Union(myRange(No1 + 1), Cell1) ' 2セル目以降をセット
End If
End If
End Sub
' 選択されたセルの色を塗る
Sub SetIro1(ByRef myRange() As Range, ByRef myFlag1() As Variant, ByVal No1 As Integer, ByVal myColor1 As Long)
If myFlag1(No1) = 1 Then
myRange(No1).Select ' セル選択
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = myColor1
.TintAndShade = 0
End With
End If
End Sub
' 選択されたセルの色を塗る（色無し）
Sub SetIro2(ByRef myRange() As Range, ByRef myFlag1() As Variant, ByVal No1 As Integer)
If myFlag1(No1) = 1 Then
myRange(No1).Select ' セル選択
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub
【エクセルシート】
・A2-A32セル：日を表示します。表示形式は"d"です。
A2セル：その月の1日を「yyyy/mm/dd」の形式で入力します。例えば「2014/7/1」のように。
A3セル：「=A2+1」の式が入っています。2日を表します。
｜
A32セル：「=A31+1」の式が入っています。31日を表します。
・B2-B32セル：曜日を表示します。表示形式は"aaa"です。
日曜日のセルをピンクで塗るため、=TEXT(A2,"aaa")="日"の条件付き書式を設定しています。
土曜日のセルを水色で塗るため、=TEXT(A2,"aaa")="土"の条件付き書式を設定しています。
B2セル：「=A2」の式が入っています。1日の曜日を表します。
B3セル：「=A3」の式が入っています。2日の曜日を表します。
｜
B32セル：「=A32」の式が入っています。31日の曜日を表します。
・C2-C32セル：出社時刻を入力します。表示形式は"h:mm"です。
・D2-D32セル：退社時刻を入力します。表示形式は"h:mm"です。
"0:00"から"8:30"までの時刻を入力した場合、翌日退社扱いとなります。
・E2-E32セル：作業時間(60進)を表示します。
・名前："作業時間"
・表示形式："h:mm"
・F2-F32セル：作業時間(10進)を表示します。表示形式は"0.00"です。
・G2-G32セル：残業時間(60進)を表示します。表示形式は"h:mm"です。
・H2-H32セル：深夜時間(60進)を表示します。
・名前："深夜時間"
・表示形式："h:mm"
・E33セル：(A)作業時間(60進)の合計を表示します。
・式：=SUM(E2:E32)
・表示形式：[h]:mm
・F33セル：(B)作業時間(10進)の合計を表示します。
・式：=SUM(F2:F32)
・表示形式：0.00
・G33セル：(C)残業時間(60進)の合計を表示します。
・式：=SUM(G2:G32)
・表示形式：[h]:mm
・H33セル：(D)深夜時間(60進)の合計を表示します。
・式：=SUM(H2:H32)
・表示形式：[h]:mm
・E37セル：昼休みの開始時刻をリストから選択します。
・名前："昼休開始"
・元の値：=$G$37:$H$37
・E38セル：残業の開始時刻をリストから選択します。
・名前："残業開始"
・元の値：=$G$38:$H$38
・E39セル：深夜残業の開始時刻をリストから選択します。
・名前："深夜開始"
・元の値：=$G$39
・J2セル：年月を表示します。
・表示形式：yyyy"年"m"月"
・式：=A2
・L3セル：(E)作業日数を表示します。
・式：=COUNTA(作業時間)
・L4セル：(E)作業日数に7.75h(1日の標準作業時間)を掛けた値(F)を計算します。24で割っているのは10進⇒60進変換のため(エクセルは24hを1とするシリアル値で時間を管理しているため)。
・表示形式：[h]:mm
・式：=L3*7.75/24
・L5セル：(A)から(F)を引いた値(G)を表示します。(C)残業時間と同じ値になります。
・表示形式：[h]:mm
・式：=E33-L4
・L6セル：(H)深夜日数を表示します。
・式：=COUNTA(深夜時間)
【マクロ】
・出社時刻、退社時刻が入力されたら、マクロを自動起動します。
・出社時刻、退社時刻は、時刻のみ入力します。24:00以降に退社しても計算できるように、
・出社時刻：2014年4月1日を足す。
・退社時刻：2014年4月1日を足す。但し、0:00から8:30までの場合、さらに1日足して2014年4月2日とする。
として、作業時間、残業時間、深夜時間を計算します。
・コード
' このマクロはシートに置くこと
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("出社退社")) Is Nothing Then
' 変化が無ければ抜ける
Exit Sub
Else
' 画面更新の停止
Application.ScreenUpdating = False
' 変数の定義
Dim Time1(20) As Date ' 時刻シリアル値（定義時刻）
Dim Time2(10) As Date ' 時刻シリアル値（出社時刻、退社時刻）
Dim Time4(10) As Date ' 時刻シリアル値（昼休時刻、残業開始）
Dim n As Integer ' 整数
Dim i As Integer ' 整数
n = 32 ' 31日の行番号
' n = Cells(Rows.Count, "A").End(xlUp).Row ' A列の最終日の行
' 時刻定義
Time1(0) = DateSerial(2014, 4, 1) ' 2014年4月1日
Time1(1) = Time1(0) + TimeSerial(0, 0, 0) ' 2014年4月1日 0時0分
Time1(2) = Time1(0) + TimeSerial(8, 30, 0) ' 2014年4月1日 8時30分
Time1(3) = Time1(0) + TimeSerial(11, 45, 0) ' 2014年4月1日 11時45分
Time1(4) = Time1(0) + TimeSerial(12, 0, 0) ' 2014年4月1日 12時0分
Time1(5) = Time1(0) + TimeSerial(12, 45, 0) ' 2014年4月1日 12時45分
Time1(6) = Time1(0) + TimeSerial(13, 0, 0) ' 2014年4月1日 13時0分
Time1(7) = Time1(0) + TimeSerial(17, 15, 0) ' 2014年4月1日 17時15分
Time1(8) = Time1(0) + TimeSerial(17, 30, 0) ' 2014年4月1日 17時30分
Time1(9) = Time1(0) + TimeSerial(18, 30, 0) ' 2014年4月1日 18時30分
Time1(10) = Time1(0) + TimeSerial(19, 0, 0) ' 2014年4月1日 19時0分
Time1(11) = Time1(0) + TimeSerial(21, 30, 0) ' 2014年4月1日 21時30分
Time1(12) = Time1(0) + TimeSerial(22, 0, 0) ' 2014年4月1日 22時0分
Time1(13) = DateSerial(2014, 4, 2) ' 2014年4月2日
Time1(14) = Time1(13) + TimeSerial(2, 15, 0) ' 2014年4月2日 2時15分
Time1(15) = Time1(13) + TimeSerial(2, 45, 0) ' 2014年4月2日 2時45分
Time1(16) = Time1(13) + TimeSerial(8, 15, 0) ' 2014年4月2日 8時15分
Time1(17) = Time1(13) + TimeSerial(8, 30, 0) ' 2014年4月2日 8時30分
' 昼休み時間の定義
Select Case Range("昼休開始").Value
Case TimeSerial(11, 45, 0)
Time4(0) = Time1(3) ' 昼休み開始(11:45)
Time4(1) = Time1(5) ' 昼休み終了(12:45)
Case TimeSerial(12, 0, 0)
Time4(0) = Time1(4) ' 昼休み開始(12:00)
Time4(1) = Time1(6) ' 昼休み終了(13:00)
Case Else
Time4(0) = Time1(4) ' 昼休み開始(12:00)
Time4(1) = Time1(6) ' 昼休み終了(13:00)
End Select
' 残業開始時刻の定義
Select Case Range("残業開始").Value
Case TimeSerial(17, 30, 0)
Time4(2) = Time1(8) ' 残業開始(17:30)
Case TimeSerial(19, 0, 0)
Time4(2) = Time1(10) ' 残業開始(19:00)
Case Else
Time4(2) = Time1(8) ' 残業開始(17:30)
End Select
' 作業時間の計算
For i = 2 To n ' 1日から31日まで
If IsEmpty(Cells(i, 3)) = False Then
' 出社時刻が入力されていれば、2014年4月1日を足す
Time2(0) = Time1(0) + Cells(i, 3).Value ' 出社時刻
End If
If IsEmpty(Cells(i, 4)) = False Then
' 退社時刻が入力されていれば、2014年4月1日を足す
Time2(1) = Time1(0) + Cells(i, 4).Value ' 退社時刻
' 退社時刻が「2014年4月1日 0時0分」から「2014年4月1日 8時30分」なら、1日ずらす（翌日退社）
If (Time2(1) >= Time1(1)) And (Time2(1) <= Time1(2)) Then
Time2(1) = DateAdd("d", 1, Time2(1))
Cells(i, 4).Font.ColorIndex = 3 ' 文字色を赤に
Else
Cells(i, 4).Font.ColorIndex = 1 ' 文字色を黒に
End If
End If
If (IsEmpty(Cells(i, 3)) = True) Or (IsEmpty(Cells(i, 4)) = True) Then
' 出社時刻 or 退社時刻のいずれかが空白なら、作業時間、残業時間、深夜時間に空白を代入
Cells(i, 5).Value = "" ' 作業時間(60進)(E列)
Cells(i, 6).Value = "" ' 作業時間(10進)(F列)
Cells(i, 7).Value = "" ' 残業時間(60進)(G列)
Cells(i, 8).Value = "" ' 深夜時間(60進)(H列)
ElseIf Time2(0) > Time2(1) Then
' 出社時刻>退社時刻だったら、作業時間に空白を代入
Cells(i, 5).Value = "" ' 作業時間(60進)(E列)
Cells(i, 6).Value = "" ' 作業時間(10進)(F列)
Cells(i, 7).Value = "" ' 残業時間(60進)(G列)
Cells(i, 8).Value = "" ' 深夜時間(60進)(H列)
MsgBox "出社時刻>退社時刻(" & i - 1 & "日[" & i & "行目])"
Else
' 作業時間、残業時間、深夜時間の代入
' 作業時間(E, F列)
If mySagyouTime1(Time1, Time2, Time4) <> 0 Then
Cells(i, 5).Value = mySagyouTime1(Time1, Time2, Time4)
Cells(i, 6).Value = mySagyouTime1(Time1, Time2, Time4) * 24
Else
Cells(i, 5).Value = ""
Cells(i, 6).Value = ""
End If
' 残業時間(G列)
If myZangyouTime1(Time1, Time2, Time4) <> 0 Then
Cells(i, 7).Value = myZangyouTime1(Time1, Time2, Time4)
Else
Cells(i, 7).Value = ""
End If
' 深夜時間(H列)
If myShinyaTime1(Time1, Time2) <> 0 Then
Cells(i, 8).Value = myShinyaTime1(Time1, Time2)
Else
Cells(i, 8).Value = ""
End If
' 【注】
' 作業時間合計のセルの表示形式を「[hh]:mm」にしておくこと。
' [hh]としておくことで、24以上の時間を表示できる。
End If
Next i
' セルに色を塗る
Call Iro1
' 画面更新の再開
Application.ScreenUpdating = True
End If
End Sub
' 作業時間を算出
Function mySagyouTime1(ByRef Time1() As Date, ByRef Time2() As Date, _
ByRef Time4() As Date) As Date
Dim Time3 As Date ' 時刻シリアル値
Time3 = Time2(1) - Time2(0) ' 退社時刻 - 出社時刻
' 昼休み(11:45-12:45 or 12:00-13:00)
If Time2(0) <= Time4(0) Then
If Time2(1) >= Time4(1) Then
' 退社時刻 >= 昼休終了(12:45 or 13:00)
Time3 = Time3 - TimeSerial(1, 0, 0)
Else
' 退社時刻 < 昼休終了(12:45 or 13:00)
Time3 = Time3 - (Time2(1) - Time4(0))
End If
End If
' 休憩(17:15-17:30)
If Time2(0) <= Time1(7) And Time2(1) >= Time1(8) Then
Time3 = Time3 - TimeSerial(0, 15, 0)
End If
' 休憩(18:30-19:00)
If Time2(0) <= Time1(9) And Time2(1) >= Time1(10) Then
Time3 = Time3 - TimeSerial(0, 30, 0)
End If
' 休憩(21:30-22:00)
If Time2(0) <= Time1(11) And Time2(1) >= Time1(12) Then
Time3 = Time3 - TimeSerial(0, 30, 0)
End If
' 休憩(2:15-2:45)
If Time2(0) <= Time1(14) And Time2(1) >= Time1(15) Then
Time3 = Time3 - TimeSerial(0, 30, 0)
End If
' 休憩(8:15-8:30)
If Time2(0) <= Time1(16) And Time2(1) >= Time1(17) Then
Time3 = Time3 - TimeSerial(0, 15, 0)
End If
mySagyouTime1 = Time3
End Function
' 残業時間を算出
Function myZangyouTime1(ByRef Time1() As Date, ByRef Time2() As Date, _
ByRef Time4() As Date) As Date
Dim Time3(2) As Date ' 時刻シリアル値
' 残業の有無判定
Time3(1) = DateAdd("n", 15, Time4(2)) ' 残業開始15分後(17:45 or 19:15)
' 残業開始(17:30 or 19:00)から15分以上、勤務していたら残業ありと判定
If Time2(0) <= Time4(2) And Time2(1) >= Time3(1) Then
Time3(0) = Time2(1) - Time4(2) ' 残業時間（休憩時間含む）
' 休憩(18:30-19:00)
' 残業開始が19:00より前、かつ、出社が18:30以前、退社が19:00以降
If (Time4(2) < Time1(10)) And _
(Time2(0) <= Time1(9)) And (Time2(1) >= Time1(10)) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(21:30-22:00)
If Time2(0) <= Time1(11) And Time2(1) >= Time1(12) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(2:15-2:45)
If Time2(0) <= Time1(14) And Time2(1) >= Time1(15) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(8:15-8:30)
If Time2(0) <= Time1(16) And Time2(1) >= Time1(17) Then
Time3(0) = Time3(0) - TimeSerial(0, 15, 0)
End If
myZangyouTime1 = Time3(0)
Else
myZangyouTime1 = 0
End If
End Function
' 深夜時間を算出
Function myShinyaTime1(ByRef Time1() As Date, ByRef Time2() As Date) As Date
Dim Time3(1) As Date ' 時刻シリアル値
Time3(1) = DateAdd("n", 15, Time1(12)) ' 2014年4月1日 22時15分
' 22時0分から22時15分の間、勤務していたら深夜ありと判定
If Time2(0) <= Time1(12) And Time2(1) >= Time3(1) Then
Time3(0) = Time2(1) - Time1(12) ' 深夜時間（休憩時間含む）
' 休憩(2:15-2:45)
If Time2(0) <= Time1(14) And Time2(1) >= Time1(15) Then
Time3(0) = Time3(0) - TimeSerial(0, 30, 0)
End If
' 休憩(8:15-8:30)
If Time2(0) <= Time1(16) And Time2(1) >= Time1(17) Then
Time3(0) = Time3(0) - TimeSerial(0, 15, 0)
End If
myShinyaTime1 = Time3(0)
Else
myShinyaTime1 = 0
End If
End Function
' 作業時間、残業時間、深夜時間に着色する
Sub Iro1()
' 画面更新の停止
Application.ScreenUpdating = False
' 変数
Dim n As Integer ' 整数
Dim i, j As Integer ' 整数
Dim myRange(8) As Range
' myRange(0), myRange(1) : 作業時間(60進)あり/なし
' myRange(2), myRange(3) : 作業時間(10進)あり/なし
' myRange(4), myRange(5) : 残業時間(60進)あり/なし
' myRange(6), myRange(7) : 深夜時間(60進)あり/なし
Dim myFlag1() As Variant ' myRangeに値がsetされたら1になるフラグ
Dim mySelect As Range ' 選択されているセル
Dim myColor1() As Variant ' 色番号
myColor1() = Array(13434777, 13434777, 6750207, 6750207)
n = 32 ' 31日の行番号
' n = Cells(Rows.Count, "A").End(xlUp).Row ' A列の最終日の行
' 作業時間あり/なし、残業時間あり/なし、深夜時間あり/なしのmyRangeのフラグ
myFlag1() = Array(0, 0, 0, 0, 0, 0, 0, 0)
For i = 2 To n ' 1日から31日まで
' 作業時間(60進)(E列)、作業時間(10進)(F列)、残業時間(60進)(G列)、深夜時間(60進)(H列)の
' 各セルの値を調べて、myRangeに格納
For j = 0 To 3
Call myChkCell1(myRange(), myFlag1(), Cells(i, j + 5), j * 2)
Next j
' 現在選択されているセル
Set mySelect = Selection
' セルに色を塗る
For j = 0 To 3
Call SetIro1(myRange(), myFlag1(), j * 2, myColor1(j)) ' 時間あり
Call SetIro2(myRange(), myFlag1(), j * 2 + 1) ' 時間なし
Next j
' セル選択を元に戻す
mySelect.Select
Next i
' 画面更新の再開
Application.ScreenUpdating = True
End Sub
' 作業時間あり/なし、残業時間あり/なし、深夜時間あり/なしをセルごとに確認して、myRangeにセル番号を格納
Sub myChkCell1(ByRef myRange() As Range, ByRef myFlag1() As Variant, ByVal Cell1 As Range, ByVal No1 As Integer)
' myRange() : 作業時間あり/なし、残業時間あり/なし、深夜時間あり/なしのRange
' myFlag1() : myRangeに値がsetされたら1になるフラグ
' Cells1 : 値を確認するセルのRange
' No1 : myRange, myFlag1の添字
If Cell1.Value > 0 Then
' 時間あり(>0)
If myFlag1(No1) = 0 Then
Set myRange(No1) = Cell1 ' 1セル目をセット
myFlag1(No1) = 1 ' フラグをセット
Else
Set myRange(No1) = Union(myRange(No1), Cell1) ' 2セル目以降をセット
End If
Else
' 時間なし(=0)
If myFlag1(No1 + 1) = 0 Then
Set myRange(No1 + 1) = Cell1 ' 1セル目をセット
myFlag1(No1 + 1) = 1 ' フラグをセット
Else
Set myRange(No1 + 1) = Union(myRange(No1 + 1), Cell1) ' 2セル目以降をセット
End If
End If
End Sub
' 選択されたセルの色を塗る
Sub SetIro1(ByRef myRange() As Range, ByRef myFlag1() As Variant, ByVal No1 As Integer, ByVal myColor1 As Long)
If myFlag1(No1) = 1 Then
myRange(No1).Select ' セル選択
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = myColor1
.TintAndShade = 0
End With
End If
End Sub
' 選択されたセルの色を塗る（色無し）
Sub SetIro2(ByRef myRange() As Range, ByRef myFlag1() As Variant, ByVal No1 As Integer)
If myFlag1(No1) = 1 Then
myRange(No1).Select ' セル選択
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub
「ヤバイぜ！」 ありがとうございます。[__猫]
最近、お返しが遅れていて、｢記事にnice!がつきました。｣メールが溜まり続けています。
申し訳ございません。
by cheese999 (2014-08-10 22:08)