| |
よろしくお願いします。
出勤簿を作成中です。
・sheet1のB8:B56とI8:I56に日付セルを設け、コマンドボタンで日付入力されます。
・同様にC,K列には出勤時刻、D,L列には退勤時刻を設け、コマンドボタンで現在時刻が入力されます。
・日付入力は1日1回まで。同一日の複数入力は許可しません。（1日複数回の外出があり、その都度時刻を入力）
上記の仕様で、下記のコードを入力したのですが、
日付入力が重複された場合に出るMsgbox「日付が重複…」がOKクリック後も何度も表示されてしまいます。
ただし、この不具合は1回目の"打刻"では発生せず、3・4回目から発生しやすくなります。
どの部分に誤りがあるのでしょうか？
ご教授いただければ幸いです。
■sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)
If target.Column <> 2 And target.Column <> 9 Then Exit Sub
If Application.WorksheetFunction.CountIf(Range("B:I"), target.Value) > 1 Then
MsgBox "日付が重複しています。", vbCritical
target.Value = ""
End If
End Sub
■標準モジュール
Sub recday_Click()
If Not Application.Intersect(ActiveCell, Range("B8:B56,I8:I56")) Is Nothing Then
ActiveCell.Value = Day(Date) & " " & WeekdayName(Weekday(Now), True)
ActiveCell.Offset(0, 1).Select
Else
MsgBox "そのセルには入力できません。", vbCritical
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
