|
えっと遅くなりましたが、そーいう仕様ならたぶんこんなコードになります。
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 i As Long
Dim Unm As String
With Target
If .Address <> "$E$6" Then Exit Sub
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
Stm = CSng(.Offset(, -1).Value)
Etm = CSng(.Value)
End With
If Stm >= Etm Then
Flg = True: GoTo ELine
End If
i = 6
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
If .CountA(Cells(i, 6).Resize(, 37)) = 0 Then Exit Do
i = i + 1
Loop
Do
Unm = InputBox("氏名を入力して下さい")
Loop While Unm = ""
ELine:
.EnableEvents = False
If Flg Then
Range("D6:E6").ClearContents
Else
Range(Cells(i, Sc), Cells(i, Ec)).Value = Unm
End If
.EnableEvents = True
End With
End Sub
|
|