Excel VBA質問箱 IV

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

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


7432 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【39227】日を指定して入力するには
質問  ABC  - 06/6/20(火) 10:22 -

引用なし
パスワード
   おはようございます。
シートに氏名の欄を作り、その横のセルから日の欄を1〜31作り、1ヶ月の宿泊予定表を作りました。
例えば、2日〜5日まで宿泊の場合、2日のセルに赤○、滞在中は○、帰る日は青◎にして現しているのですが、今は一つ一つを手作業の為時間がかかって仕方ないです。
そこで、名前の欄と日の欄の間に2行作り、1行目に入る日(2)を、2行目に帰る日(5)を入力すると、上記の様に○で表示するようにしたいのですが、できますか?
是非よろしくおねがいします。

【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
   

【39232】Re:日を指定して入力するには
質問  初心者  - 06/6/20(火) 11:30 -

引用なし
パスワード
   ▼Kein さん:
>>名前の欄と日の欄の間に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
>

早々ありがとうございます。
想像していたとおりの答えありがとうございました。
が、いくつか教えていただきたいのですが

1.セルC1に宿泊終了入力したらB1の宿泊開始も消えてしまいます・・・。
2.〜30は表示されるのですが、〜31にした場合は表示されません・・・。
3.開始の日は○(赤)ではなく、●(赤)にしたいのですが・・・。
4.例えば月をまたぐばあいは31日の欄は○(赤)にしたいのですが・・・。
5.2〜2と入力した場合▲の表示がでるようにしたいのですが・・・。

せっかく答えていただいたのに沢山の質問をして申し訳ありません・・・。
もしよろしければお答え下さい。

【39233】Re:日を指定して入力するには
発言  Kein  - 06/6/20(火) 11:46 -

引用なし
パスワード
   >月をまたぐばあい
これは単に"日の数値(1〜31)"を入力しただけでは、何月から何月にまたがる
のか分かりませんよね ? 想定していたのは D1 に 1 が入り、E1,F1・・と
AH1 まで連続した数値がある、という表です。これで大の月も小の月も一ヶ月分
のデータなら処理が可能になる、と考えてましたが。

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