Excel VBA質問箱 IV

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

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


42100 / 76732 ←次へ | 前へ→

【39703】Re:「入力済み」とMSGを出すには
質問  にしもり  - 06/6/29(木) 12:12 -

引用なし
パスワード
   自分なりに考えてコードを変えさせていただきました。見当はずれなことをやっているかもしれませんがどうか笑わないでください。
いま問題となっているのは2点です。

9:00のコマつまりF6が空白、9:15のコマつまりG6がAAになっているとします。

例1.D6で9:00、E6で9:15が選択されたとします。
そのとき"その時間帯は入力済みです"に行かせたいわけです。
SC=6、EC=7ですからMyR = Range(Cells(6, 6), Cells(6, 7))となるから
MyR はEmptyではないとおもいます。なのに(あ)に行きません。なぜでしょうか?

例2.D6で9:00、E6で9:00が選択されたとします。
そのときF6に、たとえばAAと入るところまではいいのだが、他のすべての空白セルにAAと入ってしまいます。なぜでしょうか?
(ただ、背景色が付くのはF6だけでした。)

アドバイスよろしくお願いします。

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 MyR.Count = 1 Thenを↓に変えてみました
  If Not MyR.Count = 0 Then
 
'  上記IF文のThen以下とElse以下を、入れかえてみました↓
   If WorksheetFunction.CountA(MyR) = MyR.Count Then
     MsgBox "その時間帯は入力済みです", 48
     GoTo ELine2
   Else
     GoTo ELine
   End If
 
  Else
   If IsEmpty(MyR.Value) Then
     GoTo ELine
   Else
'  追加しました↓ (あ)
     MsgBox "その時間帯は入力済みです", 48
     GoTo ELine2
   End If
  End If
 
'  NmAry = Array("AA", "BB", "CC", "DD", "EE", _
'  "FF", "GG", "HH", "II", "JJ", "KK", "LL", "MM")
'  ClAry = Array(46, 47, 48, 49, 50, 51, 52, 53, 54, 3, 5, 6, 8)
'  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) > 13
'  Unm = NmAry(CInt(Num) - 1): Col = ClAry(CInt(Num) - 1)
ELine:
  Application.EnableEvents = False
  If Flg Then
   MsgBox "入力した値は条件に一致しません。" & _
   "クリアして終了します", 48
  Else
'**挿入ここから**
  NmAry = Array("AA", "BB", "CC", "DD", "EE", _
  "FF", "GG", "HH", "II", "JJ", "KK", "LL", "MM")
  ClAry = Array(46, 47, 48, 49, 50, 51, 52, 53, 54, 3, 5, 6, 8)
  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) > 13
  Unm = NmAry(CInt(Num) - 1): Col = ClAry(CInt(Num) - 1)
'**ここまで**
   MyR.SpecialCells(4).Value = Unm
   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



8 hits

【39624】「入力済み」とMSGを出すには にしもり 06/6/27(火) 17:50 質問
【39632】Re:「入力済み」とMSGを出すには Kein 06/6/27(火) 23:16 回答
【39641】Re:「入力済み」とMSGを出すには にしもり 06/6/28(水) 4:25 質問
【39644】Re:「入力済み」とMSGを出すには にしもり 06/6/28(水) 9:00 質問
【39651】Re:「入力済み」とMSGを出すには にしもり 06/6/28(水) 10:23 質問
【39655】Re:「入力済み」とMSGを出すには Kein 06/6/28(水) 13:32 回答
【39660】Re:「入力済み」とMSGを出すには にしもり 06/6/28(水) 14:18 質問
【39703】Re:「入力済み」とMSGを出すには にしもり 06/6/29(木) 12:12 質問
【39707】Re:「入力済み」とMSGを出すには にしもり 06/6/29(木) 13:29 質問
【39715】Re:「入力済み」とMSGを出すには にしもり 06/6/29(木) 15:30 質問
【39719】Re:「入力済み」とMSGを出すには にしもり 06/6/29(木) 18:20 質問
【39732】Re:「入力済み」とMSGを出すには Kein 06/6/29(木) 23:41 発言
【39733】Re:「入力済み」とMSGを出すには Kein 06/6/29(木) 23:42 発言
【39736】Re:「入力済み」とMSGを出すには にしもり 06/6/30(金) 9:09 質問
【39740】Re:「入力済み」とMSGを出すには にしもり 06/6/30(金) 9:36 質問
【39744】Re:「入力済み」とMSGを出すには にしもり 06/6/30(金) 10:32 回答

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