Excel VBA質問箱 IV

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

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


42610 / 76732 ←次へ | 前へ→

【39187】Re:Inputboxでなくリストにするには
質問  にしもり  - 06/6/19(月) 16:37 -

引用なし
パスワード
   ▼Jaka さん:
まことにありがとうございます。
ですが、 Cel.ColorIndex = No  でひっかかってしまいます。
NoにはColorIndexが入っているとおもうのですが・・。
どうしてでしょうか?

なお、AAとBBだけでなくCCやDD等も入力されますので勝手乍らSelectを復活させました。この点も合っているでしょうか?自信ありません。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Stm As String, Etm As String, Unm As String
  Dim Sc As Integer, Ec As Integer, Rc As Long
  Dim FLG As Boolean
  Dim C As Range
  Dim MyRow As Integer
  Dim i As Integer
  Dim j As Integer
  Dim MyVal As String
  Dim Cel As Range
  Dim FLG2 As Boolean

  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

'  Do
'   Unm = InputBox("氏名を入力して下さい")
'  Loop While Unm = ""
   
    Unm = InputBox("氏名を入力して下さい")
  If Unm = "" Then Exit Sub

  
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
 
 
  MyRow = ActiveSheet.Range("A130").End(xlUp).Row
  FLG2 = False
  For Each Cel In Cells(6, 6).Resize(MyRow - 6 + 1, 36)
    Select Case Cel
      Case Cel.Value = "AA"
        FLG2 = True
        No = 46
      Case Cel.Value = "BB"
        FLG2 = True
        No = 47
      Case Cel.Value = "CC"
        FLG2 = True
        No = 48
    End Select
    If FLG2 = True Then
     Cel.ColorIndex = No '←ここでひっかかる
     Cel.Pattern = xlSolid
     Cel.PatternColorIndex = xlAutomatic
     FLG2 = False
    End If
   Next
 
End Sub

3 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 お礼

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