Excel VBA質問箱 IV

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

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


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

11107 / 76807

←次へ　｜　前へ→


	【71242】メッセージボックスが何度も出る

まる - 12/2/14(火) 11:55 -


	引用なし

	パスワード

よろしくお願いします。

出勤簿を作成中です。
・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

4 hits

▼

【71242】メッセージボックスが何度も出る まる 12/2/14(火) 11:55

≪