Excel VBA質問箱 IV

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

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


42567 / 76732 ←次へ | 前へ→

【39230】Re:日を指定して入力するには
回答  Kein  - 06/6/20(火) 11:06 -

引用なし
パスワード
   >名前の欄と日の欄の間に2行作り、1行目に入る日(2)を、2行目に帰る日(5)を
>入力すると、上記の様に○で表示

   A     B     C     D     E
1  氏名   宿泊開始  宿泊終了   1     2
2  田中     2     5
3  中村

というような表になるとすれば

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim CkD As Integer, Sdy As Integer, Edy As Integer
  Dim TR As Long
  Dim Flg As Boolean

  CkD = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
  With Target
   If .Column <> 3 Then Exit Sub
   If IsEmpty(.Offset(, -2).Value) Then
     Flg = True: GoTo ELine
   End If
   If WorksheetFunction.Count(.Offset(, -1).Resize(, 2)) < 2 Then
     Flg = True: GoTo ELine
   End If
   If .Offset(, -1).Value > .Value Then
     Flg = True: GoTo ELine
   End If
   If .Value > CkD Then
     Flg = True: GoTo ELine
   End If
   TR = .Row
   Sdy = CInt(.Offset(, -1).Value) + 3
   Edy = CInt(.Value) + 3
  End With
  Rows(TR).Font.ColorIndex = xlColorIndexAutomatic
  Application.EnableEvents = False
  Cells(TR, 4).Resize(, 31).ClearContents
  If Sdy = Edy Then
   With Cells(TR, Sdy)
     .Value = "○": .Font.ColorIndex = 3
   End With
  Else
   With Range(Cells(TR, Sdy), Cells(TR, Edy - 1))
     .Value = "○": .Font.ColorIndex = 3
   End With
   With Cells(TR, Edy)
     .Value = "◎": .Font.ColorIndex = 5
   End With 
  End If
ELine:  
  If Flg Then Target.Offset(, -1).Resize(, 2).ClearContents
  Application.EnableEvents = True
End Sub
   
4 hits

【39227】日を指定して入力するには ABC 06/6/20(火) 10:22 質問
【39230】Re:日を指定して入力するには Kein 06/6/20(火) 11:06 回答
【39232】Re:日を指定して入力するには 初心者 06/6/20(火) 11:30 質問
【39233】Re:日を指定して入力するには Kein 06/6/20(火) 11:46 発言

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