|
入力規制が設定されている範囲は、D:E列の6行目から11行目までに
限定しても良いのですね ? それなら
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Stm As Single, Etm As Single
Dim Sc As Variant, Ec As Variant
Dim Flg As Boolean
Dim Rc As Long
Dim Unm As String
If Intersect(Target, Range("E6:E11")) _
Is Nothing Then Exit Sub
With Target
If .Count > 1 Then Exit Sub
If IsEmpty(.Offset(, -1).Value) Then Exit Sub
If Not .Validation.Value Then
Flg = True: GoTo ELine
End If
Rc = .Row
Stm = CSng(.Offset(, -1).Value)
Etm = CSng(.Value)
End With
If Stm >= Etm Then
Flg = True: GoTo ELine
End If
With Application
Sc = .Match(Stm, Rows(4), 1)
Ec = .Match(Etm, Rows(4), 1)
If IsError(Sc) Or IsError(Ec) Then
Flg = True: GoTo ELine
End If
Do
Unm = InputBox("氏名を入力して下さい")
Loop While Unm = ""
ELine:
.EnableEvents = False
If Flg Then
MsgBox "入力した値は間違っています。" & _
"クリアして終了します", 48
Cells(Rc, 4).Resize(, 2).ClearContents
Else
Cells(Rc, 6).Resize(, 37).ClearContents
Range(Cells(Rc, Sc), Cells(Rc, Ec)).Value = Unm
End If
.EnableEvents = True
End With
End Sub
|
|