| |
はるとさん、こんばんは
仕事場の都合でなかなか返事ができない状況で申し訳ないです。
>・１日が５行あり、Ｊ列とＫ列以外は列ごとに結合されています。
> （１０行目〜１５行目までが１０日のようなものです。）
>・休憩開始と終了時間は５行のうち昼休みを１行目、１７：４５以降の休憩を２行目という形で入力しています。
>・休憩時間以外は、結合された列の１行目に入力されています。
行単位でセルの結合をされているようなので、前のVBAではうまく動かないですね。
はるとさんのワークシートはこちらから見れませんので質問する際は、かみちゃん
さんのおっしゃるとおり、シートレイアウトやサンプルデータを提示したほうが、
手戻りが少なくていいと思います。
データの入力形式によってはうまく動かないかもしれませんが、こんな感じでどう
でしょうか？
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 = #6:00: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 = 2 'データ開始行は2行目から
Set SHT = ThisWorkbook.Sheets(シート名)
EndRow = SHT.Range(日付 & "65536").End(xlUp).Row
For iii = StartRow To EndRow Step 5
'出社時間チェック
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
|
|
こたつねこ
- 08/9/4(木) 21:30 -
