Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

24556 / 76807

←次へ　｜　前へ→


	【57599】Re:勤怠の自動チェック方法について質問です。

こたつねこ - 08/9/3(水) 22:26 -


	引用なし

	パスワード

はるとさん、こんばんは

とりあえず作ってみました。
日付をまたがる様な処理は考えていません。
シート名【勤怠】の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

1 hits

▼

【57592】勤怠の自動チェック方法について質問です。 はると 08/9/3(水) 17:36