エクセルマクロで15日締めの出勤管理表を作ってみることにします。
管理表の上の部分です。
下の部分です。
マクロを実行して表を作りました。
今回は以前の記事で書かせていただいた、出勤管理表の
まず前提として、15日締めということですので、カレンダーが
2ヶ月分必要になるということになります。
例えば2021年8月25日支払いなら、7月16日から7月31日と8月1日から
8月15日のカレンダーが必要なわけです。
そして2ヶ月必要ということは、年を跨ぐ12月と1月があるということです。
この年を跨ぐ処理をどうやるかということは別の記事（7月27日）で書いていますし、
日付・曜日の書き込み方も書いてありますので、特に問題はないと
思います。
あとは勤務時間の計算をすればいいだけです。
勤務時間の時間と分をわけて書き込むところとか、給与の合計を
する式とかはちょっと考えるかもしれません。
このマクロには作成時間が測定出来るようにちょっと
おちゃめなことをしています。
これも好きにお使いいただけばと思います。
最後にデータのダウンロードも出来るようにしていますので
ご活用ください。
本日もお読みいただきありがとうございました。
Sub Macro15日締め出勤管理表作成()'
' Macro2 Macro
'
On Error Resume Next
Application.ScreenUpdating = False
starttime = Timer '処理開始時間をセット
Call Macro2 '今の表の内容をクリアーする
Range("b2").Select
a = ActiveCell.Value
Range("b3").Select
b = ActiveCell.Value
If b = 1 Then '1月のときは年を引いて月を13にする
a = a - 1
b = 13
Else
a = a
End If
e1 = a & "/" & b - 1 '以下4行で当月の日数を出してdに代入
e = e1 & "/01"
f = DateSerial(Year(e), Month(e) + 1, Day(e))
d = Day(DateSerial(Year(f), Month(f), Day(f) - 1))
For i = 6 To 36 'ループは固定で回す 前月の処理
Range("b" & i).Select
If Range("c36").Value <> "" Then Exit For 'ｃ列の最後の曜日が空かどうか空でなければループから出る
c1 = i - 5 + 15 '月の16日から書き出す
Range("b" & i).Select
ActiveCell.FormulaR1C1 = c1 '日付を書き出す
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Range("c" & i).Select
Select Case Weekday(a & "年" & b - 1 & "月" & c1 & "日") '何年何月何日が何曜日か判断
Case 1 'セレクトケースで処理をさせる
If Err.Number <> 0 Then Exit For
ActiveCell.FormulaR1C1 = "日"
Selection.Font.ColorIndex = 3
Range("b" & i & ":g" & i).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Case 2
ActiveCell.FormulaR1C1 = "月"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 3
ActiveCell.FormulaR1C1 = "火"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 4
ActiveCell.FormulaR1C1 = "水"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 5
ActiveCell.FormulaR1C1 = "木"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 6
ActiveCell.FormulaR1C1 = "金"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 7
ActiveCell.FormulaR1C1 = "土"
Selection.Font.ColorIndex = 5
End Select
If d = c1 Then '月の日数と日付の日数を比較 同じなら当月の処理 違えば前月の処理
Range("b2").Select
a = ActiveCell.Value
Range("b3").Select
b = ActiveCell.Value
k = 0 '日付を入れる変数をKにしてリセット
For j = d - 15 + 6 To 36 'ループｊの開始場所を設定してｍまで回す
k = k + 1 '日付を一日づつ増やす
Range("b" & j).Select
ActiveCell.FormulaR1C1 = k '日付を書き込む
Range("c" & j).Select
Select Case Weekday(a & "年" & b & "月" & k & "日")
Case 1
If Err.Number <> 0 Then Exit For
ActiveCell.FormulaR1C1 = "日"
Selection.Font.ColorIndex = 3
Range("b" & j & ":g" & j).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Case 2
ActiveCell.FormulaR1C1 = "月"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 3
ActiveCell.FormulaR1C1 = "火"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 4
ActiveCell.FormulaR1C1 = "水"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 5
ActiveCell.FormulaR1C1 = "木"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 6
ActiveCell.FormulaR1C1 = "金"
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Case 7
ActiveCell.FormulaR1C1 = "土"
Selection.Font.ColorIndex = 5
End Select
Next
End If
Next i
e = CStr(ActiveSheet.Name) 'シート名を変える
Sheets(e).Name = b & "月支払"
endtime = Timer '処理終了時間をセット
Range("i13").Select
ActiveCell.FormulaR1C1 = "作成処理時間は" & endtime - starttime & "秒"
Range("a1").Select
End Sub
Sub Macro2()
'
' Macro2 Macro 'マクロの記録で記録したものをそのまま使います
'
'
Range("B6:G36").Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub 勤務時間等計算()
'
' Macro1 Macro
'
'
Application.ScreenUpdating = False
v = 0 '時間合計vをクリアー
k = 0 '出勤日数kをクリアー
n = Cells(Rows.Count, "b").End(xlUp).Row
For i = 6 To n
Range("D" & i).Select
a = ActiveCell.Value '出勤時刻をaに
Range("E" & i).Select
b = ActiveCell.Value '退社時刻をbに
Range("F" & i).Select
c = ActiveCell.Value '中断時間をcに
Range("G" & i).Select
w = b - a - c '勤務時間を計算
ActiveCell.FormulaR1C1 = w
If a <> "" Then '出勤時刻にdataがあれば出勤日を足していく
k = k + 1
End If
If w = 0 Then '勤務時間が0のときは空欄にする
ActiveCell.FormulaR1C1 = ""
End If
v = v + w '勤務時間を足していく
Next
Range("g38").Select
ActiveCell.FormulaR1C1 = Int(v * 24) '24倍して時間に直(Hourだとだめ）して記入
Range("g39").Select
ActiveCell.FormulaR1C1 = Minute(v) '合計時間から分だけ取り出して記入
Range("g40").Select
ActiveCell.FormulaR1C1 = k '勤務日を記入
Range("e42").Select
j = ActiveCell.Value '時給をJに代入
Range("e43").Select
m = ActiveCell.Value '交通費をmに代入
Range("g42").Select
ActiveCell.FormulaR1C1 = j * Int(v * 24) + j / 60 * Minute(v) '給与の合計（時給に時間をかけて、時給を分給にして分ををかける）
Range("g43").Select
ActiveCell.FormulaR1C1 = m * k '交通費合計
Range("g48").Select
ActiveCell.FormulaR1C1 = j * Int(v * 24) + j / 60 * Minute(v) + m * k '給与の合計と交通費を足す
Range("a1").Select
End Sub
表をつくるのが面倒というのであれば以下をどうぞ。
今日もお読みいただきありがとうございました。
コメント