| |
▼neptune さん：
こんにちは。
AA,BB・・は名前です。
百も承知などということはございません。初級者です。
開始時間帯と終了時間帯を入れるとUserFormが出るところまではできました。
最後にコンボボックスで選んだ名前を選択して、開始時間帯、終了時間帯、名前がそろいます。
やりたいことは、たとえばD6で9:00、E6で9:15、UserformでAAをそれぞれ選んだら
F6,G6にそれぞれAAが入り、当該セルがアクア色になるようにしたいのです。
なおF4には9:00,G4には9:15・・・・・AP4には18:00とあらかじめ入っています。
また、D6以下の行はプルダウンで開始時間帯を9:00,9:15・・・18:00から、
E6以下の行はプルダウンで終了時間帯を9:00,9:15・・・18:00から選ぶことになっています。
週末に考えましたが、UserFormに変えたことによって、コメント化した個所をどうかえればいいかわかりません。
もしよろしくければアドバイスいただけますと幸いです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Stm As String, Etm As String
Dim St As String, Unm As String, ComS As String
Dim Sc As Integer, Ec As Integer
Dim Rc As Long, I As Integer, Col As Integer
Dim Flg As Boolean
Dim MyR As Range, C As Range
Dim NmAry As Variant, ClAry 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
Rc = .Row
If Not .Validation.Value Then
Flg = True: GoTo ELine
End If
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 C.Text = Etm Then Ec = C.Column: Exit For
Next
If Sc = 0 Or Ec = 0 Then
Flg = True: GoTo ELine
End If
Set MyR = Range(Cells(Rc, Sc), Cells(Rc, Ec))
If Not MyR.Count = 0 Then
If WorksheetFunction.CountA(MyR) >= 1 Then
MsgBox "その時間帯は入力済みです", 48
GoTo ELine2
End If
Else
If IsEmpty(MyR.Value) Then
GoTo ELine
End If
End If
ELine:
Application.EnableEvents = False
If Flg Then
MsgBox "入力した値は条件に一致しません。" & _
"クリアして終了します", 48
Else
UserForm1.Show
NmAry = Array("AA", "BB", "CC", "DD", "EE", _
"FF", "GG", "HH", "II", "JJ", "KK", "LL", "MM", "MM1", "MM2", "MM3", "MM4", "MM5", "MM6")
Me.ComboBox1.Style = fmStyleDropDownList
For I = 0 To UBound(NmAry) - 1
Me.ComboBox1.AddItem NmAry(I)
Next I
ClAry = Array(42, 50, 39, 40, 46, 46, 46, 46, 46, 46, 36, 35, 3, 38, 4, 43, 6, 41, 8)
'↓UserFormに変えたことで、ここをどうかえればいいかわかりません。
' St = "[ﾕﾆｯﾄの番号を下表に従って入力して下さい]" & _
' vbLf & "AA = 1 : "
' For I = 1 To UBound(NmAry)
' If I Mod 3 = 0 Then
' St = St & NmAry(I - 2) & " = " & I - 1 & _
' " : " & NmAry(I - 1) & " = " & I & _
' " : " & NmAry(I) & " = " & I + 1 & vbLf
' End If
' Next I
'
' St = Left$(St, Len(St) - 1)
' Do
' Num = Application.InputBox(St, Type:=1)
' If VarType(Num) = 11 Then GoTo ELine2
' Loop While CInt(Num) < 1 Or CInt(Num) > 19
' Unm = NmAry(CInt(Num) - 1): Col = ClAry(CInt(Num) - 1)
' MyR.Value = Unm
MyR.Value = Me.ComboBox1.AddItem NmAry(I)
MyR.Interior.ColorIndex = Col
ComS = InputBox("ｺﾒﾝﾄを入力できます。")
If ComS <> "" Then
Cells(Rc, Sc).AddComment ComS
Cells(Rc, Sc).Comment.Visible = False
End If
End If
ELine2:
Cells(Rc, 4).Resize(, 2).ClearContents
Application.EnableEvents = True
Set MyR = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
