| |
はるとさん、こんばんは
とりあえず作ってみました。
日付をまたがる様な処理は考えていません。
シート名【勤怠】の1行目にヘッダ、2行目以降データが記述され
各時間は時刻型で入力されているものとして、多分こんな感じかと
標準モジュールにどぞ
Public Sub 勤怠チェック()
'定数---シート名や列の場所が違うときはここを変更して！
Const シート名 As String = "勤怠"
Const 日付 As String = "A"
Const 出社時間列 As String = "I"
Const 始業時間列 As String = "C"
Const 退社時間列 As String = "J"
Const 終業時間列 As String = "D"
Const 休憩開始列 As String = "E"
Const 休憩終了列 As String = "F"
Const 遅刻許容 As Date = #12:30:00 AM#
Const 早退許容 As Date = #12:30:00 AM#
Const 休憩チェック As Date = #6:00:00 PM#
Const 休憩開始時間 As Date = #5:45:00 PM#
Const 休憩終了時間 As Date = #6:00:00 PM#
Dim SHT As Excel.Worksheet
Dim StartRow As Long
Dim EndRow As Long
Dim iii As Long
StartRow = 2 'データ開始行は2行目から
Set SHT = ThisWorkbook.Sheets(シート名)
EndRow = SHT.Range(日付 & "1").End(xlDown).Row
For iii = StartRow To EndRow
'出社時間チェック
If (SHT.Range(始業時間列 & iii).Value + 遅刻許容 - SHT.Range(出社時間列 & iii).Value) <= 0 Then
SHT.Range(出社時間列 & iii).Interior.Color = vbRed
End If
'退社時間チェック
If (SHT.Range(終業時間列 & iii).Value - 早退許容 - SHT.Range(退社時間列 & iii).Value) >= 0 Then
SHT.Range(退社時間列 & iii).Interior.Color = vbRed
End If
'休憩時間チェック
If (休憩チェック <= SHT.Range(退社時間列 & iii).Value) Then
If (SHT.Range(休憩開始列 & iii).Value <> 休憩開始時間) Then SHT.Range(休憩開始列 & iii).Interior.Color = vbRed
If (SHT.Range(休憩終了列 & iii).Value <> 休憩終了時間) Then SHT.Range(休憩終了列 & iii).Interior.Color = vbRed
End If
Next
End Sub
|
|
こたつねこ
- 08/9/3(水) 22:26 -
