Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


42608 / 76735 ←次へ | 前へ→

【39192】Re:Inputboxでなくリストにするには
回答  Kein  - 06/6/19(月) 16:49 -

引用なし
パスワード
   未テストですが、こんな感じでどうでしょーか ?
プルダウンするコントロールを配置する方法もありますが、より簡単に済ませるため
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

0 hits

【38997】Inputboxでなくリストにするには にしもり 06/6/15(木) 17:55 質問
【39151】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 11:36 質問
【39165】Re:Inputboxでなくリストにするには Jaka 06/6/19(月) 14:37 発言
【39167】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 14:47 質問
【39175】Re:Inputboxでなくリストにするには Jaka 06/6/19(月) 15:50 発言
【39187】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 16:37 質問
【39191】Re:Inputboxでなくリストにするには Jaka 06/6/19(月) 16:49 発言
【39192】Re:Inputboxでなくリストにするには Kein 06/6/19(月) 16:49 回答
【39196】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 17:11 質問
【39197】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 17:14 発言
【39198】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 17:19 質問
【39201】Re:Inputboxでなくリストにするには Kein 06/6/19(月) 17:50 回答
【39202】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 18:08 質問
【39203】Re:Inputboxでなくリストにするには にしもり 06/6/19(月) 18:20 質問
【39206】Re:Inputboxでなくリストにするには Kein 06/6/19(月) 18:53 回答
【39249】Re:Inputboxでなくリストにするには にしもり 06/6/20(火) 15:05 お礼
【39251】Re:Inputboxでなくリストにするには Kein 06/6/20(火) 15:39 発言
【39264】Re:Inputboxでなくリストにするには にしもり 06/6/20(火) 18:02 お礼

42608 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free