Excel VBA質問箱 IV

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

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


43074 / 76732 ←次へ | 前へ→

【38715】Re:TRUEの場合にそのセルのみ値にするには
回答  Kein  - 06/6/8(木) 21:53 -

引用なし
パスワード
   諸点を修正して以下のようなコードで、うまくいくと思います。
>D11に限定してるわけではないですがそこのところは自分でD31とかに直します
これはコードを書き換えなくても、入力規制を設定した範囲を自動的に取得
するように修正しました。ただし、D:E列の6行目以下に1つも入力規則を設定
したセルが無いとエラーで中断してしまいます。ご注意下さい。

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
 
  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 WorksheetFunction _
   .CountA(Cells(Rc, 6).Resize(, 37)) > 0 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
   ElseIf C.Text = Etm Then
     Ec = C.Column: Exit For
   End If
  Next
  If Sc = 0 Or Ec = 0 Then
   Flg = True: GoTo ELine
  End If
  Do
   Unm = InputBox("氏名を入力して下さい")
  Loop While Unm = ""
ELine:
  Application.EnableEvents = False
  If Flg Then
   MsgBox "入力した値は条件に一致しません。" & _
   "クリアして終了します", 48
   Cells(Rc, 4).Resize(, 2).ClearContents
  Else
   Cells(Rc, 6).Resize(, 37).ClearContents
   Range(Cells(Rc, Sc), Cells(Rc, Ec)).Value = Unm
  End If
  Application.EnableEvents = True
End Sub

2 hits

【38613】TRUEの場合にそのセルのみ値にするには にしもり 06/6/7(水) 11:08 質問
【38625】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/7(水) 16:02 回答
【38631】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/7(水) 16:38 質問
【38634】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/7(水) 16:47 発言
【38635】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/7(水) 17:02 発言
【38636】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/7(水) 17:04 回答
【38641】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/7(水) 17:28 質問
【38673】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/8(木) 12:08 質問
【38675】Re:TRUEの場合にそのセルのみ値にするには やっちん 06/6/8(木) 12:33 発言
【38678】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/8(木) 13:21 質問
【38681】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/8(木) 14:19 質問
【38686】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/8(木) 14:56 回答
【38699】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/8(木) 17:15 質問
【38701】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/8(木) 17:37 回答
【38702】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/8(木) 17:47 発言
【38704】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/8(木) 18:14 質問
【38715】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/8(木) 21:53 回答
【38730】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/9(金) 9:35 質問
【38777】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/9(金) 21:34 回答
【38823】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/11(日) 16:32 質問
【38825】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/11(日) 17:53 回答
【38835】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/12(月) 1:01 お礼
【38913】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/14(水) 11:45 質問
【38932】Re:TRUEの場合にそのセルのみ値にするには Kein 06/6/14(水) 18:21 回答
【38934】Re:TRUEの場合にそのセルのみ値にするには にしもり 06/6/14(水) 18:38 お礼

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