| |
未テストですが、こんな感じでどうでしょーか ?
プルダウンするコントロールを配置する方法もありますが、より簡単に済ませるため
InputBoxに番号を入れる方法にしています。
ただし、名前が多くなると表示し切れなくなるので、7名ぐらいにしておいて下さい。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Stm As String, Etm As String
Dim St As String, Unm As String
Dim Sc As Integer, Ec As Integer
Dim Rc As Long, i As Integer
Dim Flg As Boolean
Dim C As Range
Dim NmAry As Variant, Num As Variant
If Intersect(Target, Range("E6:E65536").SpecialCells(-4174)) _
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
If .Offset(, -1).Value > .Value Then
Flg = True: GoTo ELine
End If
Range("D6:E65536").SpecialCells(-4174).NumberFormat = "h:mm"
Stm = .Offset(, -1).Text
Etm = .Text
End With
For Each C In Range("F4:AP4")
If C.Text = Stm Then Sc = C.Column
If Sc > 0 Then
If Not IsEmpty(Cells(Rc, Sc).Value) Then
MsgBox "その時間帯は入力済みです", 48: Exit Sub
End If
End If
If C.Text = Etm Then Ec = C.Column: Exit For
Next
If Sc = 0 Or Ec = 0 Then
Flg = True: GoTo ELine
End If
NmAry = Array("AA", "BB", "CC", "DD", "EE", "FF", "GG")
St = "[氏名の番号を下記の対応表に従って入力して下さい]" & vbLf
For i = 0 To UBound(NmAry) - 1 'NmAryの要素数が偶数なら - 1 を削除
If i Mod 2 = 0 Then
St = St & NmAry(i) & " = " & i + 1 & _
" : " & NmAry(i + 1) & " = " & i + 2 & vbLf
End If
Next i
Do
Num = Application.InputBox(St, Type:=1)
If VarType(Num) = 11 Then Exit Sub
Loop While CInt(Num) < 1 Or CInt(Num) > 7
Unm = NmAry(CInt(Num) - 1)
ELine:
Application.EnableEvents = False
If Flg Then
MsgBox "入力した値は条件に一致しません。" & _
"クリアして終了します", 48
Else
Range(Cells(Rc, Sc), Cells(Rc, Ec)).Value = Unm
End If
Cells(Rc, 4).Resize(, 2).ClearContents
Application.EnableEvents = True
End Sub
|
|
Kein
- 06/6/19(月) 16:49 -
