|
再度テストして、こちらでも現象を確認しました。数値の入力と日付の入力の
タイミングが問題になるようですね・・。何度か改造してみましたが、セル入力
イベントだけではうまく回避できなかったので、セル選択イベントを追加し、
事前に元の日付をクリアするようにしてみました。
再度全体を書き直して、以下のようなマクロになりました。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim MyD As Integer, AdM As Integer
Dim CkD As Date, SetD As Date
With Target
If Intersect(.Cells, Range("B20:B350")) Is _
Nothing Then Exit Sub
If .Count > 1 Then Exit Sub
If IsEmpty(.Value) Then Exit Sub
If Not IsNumeric(.Value) Then Exit Sub
If .Value < 1 Or .Value > 31 Then Exit Sub
MyD = .Value
End With
If Day(Date) >= 23 Then
AdM = 2
Else
AdM = 1
End If
CkD = DateSerial(Year(Date), Month(Date) + AdM, 0)
SetD = DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
If Day(CkD) < MyD Then
MsgBox MyD & " 日は存在しません", 48
Else
Application.EnableEvents = False
With Target
.Clear
.NumberFormat = "ge.mm.dd"
.Value = SetD
End With
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If Intersect(.Cells, Range("B20:B350")) Is _
Nothing Then Exit Sub
If IsDate(.Value) Then .Clear
End With
End Sub
|
|