|
はるとさん、こんばんは
前回のソースと差し替えてみてください。
シート名は、はるとさんのシート名に書き換えてくださいね。
Public Sub 勤怠チェック()
'定数
Const シート名 As String = "勤怠" '←ここを実際のシート名で書き換えてください。
Const 日付 As String = "A"
Const 出社時間列 As String = "T"
Const 始業時間列 As String = "H"
Const 退社時間列 As String = "U"
Const 終業時間列 As String = "I"
Const 休憩開始列 As String = "J"
Const 休憩終了列 As String = "K"
Const 遅刻許容 As Date = #12:30:00 AM#
Const 早退許容 As Date = #12:30:00 AM#
Const 休憩チェック As Date = #5:45:00 PM#
Const 休憩開始時間 As Date = #5:45:00 PM#
Const 休憩終了時間 As Date = #6:00:00 PM#
Const 一日の行数 As Long = 5
Dim SHT As Excel.Worksheet
Dim StartRow As Long
Dim EndRow As Long
Dim iii As Long
Dim jjj As Long
Dim blnCHECK As Boolean
StartRow = 5 'データ開始行は5行目から
Set SHT = ThisWorkbook.Sheets(シート名)
EndRow = SHT.Range(日付 & "65536").End(xlUp).Row
For iii = StartRow To EndRow Step 一日の行数
'出社時間チェック
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
blnCHECK = True
For jjj = 0 To 一日の行数 - 1
If (SHT.Range(休憩開始列 & iii).Offset(jjj, 0).Value = 休憩開始時間) Then
If (SHT.Range(休憩終了列 & iii).Offset(jjj, 0).Value = 休憩終了時間) Then
blnCHECK = False
Exit For
End If
End If
Next
If blnCHECK Then
SHT.Range(休憩開始列 & iii & ":" & 休憩終了列 & iii + 一日の行数 - 1).Interior.Color = vbRed
End If
End If
Next
End Sub
|
|