Excel VBA 質問スレッド №1985 (解決済)

イベントプロシージャで平日〇土日祝●

投稿者 : mitsu isobe     投稿日時 : 2024/08/04(Sun) 15:26:45     OS : Windows 11     EXCEL : Excel 2019
pcを扱った事が無い人がシフトを組めるよう
例えばG3:AK4カレンダーを作成G3列日付G4列曜日
で下のセルをクリックで平日〇土日祝で●組めるなら
と考えてますが、うまくいきません。
教えて下さい。お願いします。

スポンサーリンク
[返信 1] Re : イベントプロシージャで平日〇土日祝●
投稿者 : tek     投稿日時 : 2024/08/05(Mon) 06:31:33
一例です。
事前準備
データ　－　Web から　にてURLに
https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
を入れOK
左一覧からテーブル 1をクリックし、右にテーブル 1が表示されたら下の読み込みをクリック
シートに一覧が表示され、そのシート名を違っていたら"テーブル 1"に変更
"カレンダー"シートを作成し、そのシートタブを右クリックし、コードの表示(V)をクリック
以下のコードをコードペインに貼り付け「カレンダー作成」を実行

G3セルに開始日を入力


曜日表示の下の行から98行目までのセルを選択し、右クリックすると"〇"または"●"が表示されます
Option Explicit
Private Const スタート = "G3"

Private Sub カレンダー作成()
    Application.EnableEvents = False
    With Range(スタート)
        .Value = "1/1"
        .Offset(1).FormulaR1C1 = "=R[-1]C"
        .Offset(, 1).Resize(2, 30).FormulaR1C1 = "=RC[-1]+1"
        .Resize(, 31).NumberFormatLocal = "m月d日"
        .Offset(1).Resize(, 31).NumberFormatLocal = "aaaa"
    End With
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim r As Range
    Dim d
    Dim ad As String
    Set Target = Intersect(Target, Range(スタート).Offset(2).Resize(98, 31))
    If Target Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each r In Target
        With r.EntireColumn.Rows(Range(スタート).Row)
            d = .Value
            ad = .Address
        End With
        If Not IsDate(d) Then Exit For
        Cancel = True
        If Weekday(d, vbMonday) > 5 Or _
            IsNumeric(Evaluate("Match(" & ad & ",'テーブル 1'!b:b,0)")) Then
            r.Value = "●"
        Else
            r.Value = "〇"
        End If
    Next
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = スタート Then
        If MsgBox("表をクリアしますか？", vbYesNo) = vbYes Then
            Application.EnableEvents = False
            Range(スタート).Offset(2).Resize(98, 31).ClearContents
            Application.EnableEvents = True
        End If
    End If
End Sub

[返信 2] Re : イベントプロシージャで平日〇土日祝●
投稿者 : てらてら     投稿日時 : 2024/08/05(Mon) 06:53:04
こんにちは。

平日と土日に関しては、日付から得る事ができますが、
祝日は取得できないので、別シートにリストを作るかプログラム内部で配列を持って参照する事になるかと思います。

それと、曜日によって下のセルは固定されると思うので、イベントプロシージャを使う意味があるのかも疑問ですが、
クリックによって○、●を出すなら以下のようになるかと思います。

参考にしてみてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("G5:AZ5")) Is Nothing Then
        If Target.Offset(-1, 0).Text = "土" Or Target.Offset(-1, 0).Text = "日" Or Target.Offset(-1, 0).Text = "祝" Then
            Target = "●"
        Else
            Target = "○"
        End If
    End If
End Sub

[返信 3] Re : イベントプロシージャで平日〇土日祝●
投稿者 : mitsu isobe     投稿日時 : 2024/08/05(Mon) 15:26:19
てらてらさんへ
早速の投稿ありがとうございます。
実は、祝日を悩んでたので、考えます。
ありがとうございました。

[返信 4] Re : イベントプロシージャで平日〇土日祝●
投稿者 : ピロリ     投稿日時 : 2024/08/05(Mon) 18:07:37
■[返信 3] mitsu isobeさん（2024-08-05 15:26:19）の記事
＞ 実は、祝日を悩んでたので、考えます。

祝日を別表に保有すると処理も面倒にあるので、手っ取り早く、土曜・日曜・祝日の日付（3行目のセル）と
曜日（4行目のセル）を色付けしておくって手もありますよ。
⇒ 例えば、あらかじめセルをマゼンタに塗りつぶしておくとか。 ･･･ 前提(1)

また、私なら、クリックイベント処理って無いので、ダブルクリックイベント処理で○や●を設定します。
⇒ Worksheet_BeforeDoubleClickイベントを使用ってことです。 ･･･ 前提(2)

それから、○や●を設定する「下のセル」というのは 5行目のみですか？
⇒ 担当者分の複数行（20人なら G5～AK24セル）が設定範囲だったりして。 ･･･ 前提(3)

上の前提でサンプルを書いてみましたが、参考にならないようであれば読み捨てて下さい。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)   '前提(2)
    If Not Intersect(Range("G5:AK24"), Target) Is Nothing Then                      '前提(3)
        If Cells(3, Target.Column).Interior.Color = vbMagenta Then                  '前提(1)
            If Target = "" Then
                Target = "●"   'ダブルクリックで●を設定
            Else
                Target = ""     'もう１度ダブルクリックで●は消去（不要なら削除して下さい）
            End If
        Else
            If Target = "" Then
                Target = "○"   'ダブルクリックで○を設定
            Else
                Target = ""     'もう１度ダブルクリックで○は消去（不要なら削除して下さい）
            End If
        End If
        Cancel = True           '入力モードはキャンセル（不要なら削除して下さい）
    End If
End Sub

[返信 5] Re : イベントプロシージャで平日〇土日祝●
投稿者 : mitsu isobe     投稿日時 : 2024/08/10(Sat) 05:27:31
ピロリさん
大変有りがとうございます!
初めてのイベントプロシージャで苦労しております。
セルの結合してます。
セルの結合でも出来ますでしょうか？
初心者で申し訳ないです。
ピロリさんの考えるように１人6行で6人の
シフトです。
もし、よろしければ、お願いします。

[返信 6] Re : イベントプロシージャで平日〇土日祝●
投稿者 : ピロリ     投稿日時 : 2024/08/10(Sat) 09:12:27
■[返信 5] mitsu isobeさん（2024-08-10 05:27:31）の記事
＞ セルの結合してます。
＞ セルの結合でも出来ますでしょうか？

多分、ダブルクリックしようとしているセルが結合されている場合のことを言っているのかと思いますが、
結合されているセルの１つ目だけを処理させるとか？
要は、2～13step目（8ヶ所）の「Target」を「Target.Item(1)」へ変更しては？ってことですが･･･

[返信 7] Re : イベントプロシージャで平日〇土日祝●
投稿者 : mitsu isobe     投稿日時 : 2024/08/14(Wed) 16:41:12
■[返信 1] tekさん（2024-08-05 06:31:33）の記事
＞ 一例です。
＞ 事前準備
＞ データ　－　Web から　にてURLに
＞ https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
＞ を入れOK
＞ 左一覧からテーブル 1をクリックし、右にテーブル 1が表示されたら下の読み込みをクリック
＞ シートに一覧が表示され、そのシート名を違っていたら"テーブル 1"に変更
＞ "カレンダー"シートを作成し、そのシートタブを右クリックし、コードの表示(V)をクリック
＞ 以下のコードをコードペインに貼り付け「カレンダー作成」を実行
＞
＞ G3セルに開始日を入力
＞
＞
＞ 曜日表示の下の行から98行目までのセルを選択し、右クリックすると"〇"または"●"が表示されます
＞ Option Explicit
＞ Private Const スタート = "G3"
＞
＞ Private Sub カレンダー作成()
＞ Application.EnableEvents = False
＞ With Range(スタート)
＞ .Value = "1/1"
＞ .Offset(1).FormulaR1C1 = "=R[-1]C"
＞ .Offset(, 1).Resize(2, 30).FormulaR1C1 = "=RC[-1]+1"
＞ .Resize(, 31).NumberFormatLocal = "m月d日"
＞ .Offset(1).Resize(, 31).NumberFormatLocal = "aaaa"
＞ End With
＞ Application.EnableEvents = True
＞ End Sub
＞
＞ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
＞ Dim r As Range
＞ Dim d
＞ Dim ad As String
＞ Set Target = Intersect(Target, Range(スタート).Offset(2).Resize(98, 31))
＞ If Target Is Nothing Then Exit Sub
＞ Application.EnableEvents = False
＞ For Each r In Target
＞ With r.EntireColumn.Rows(Range(スタート).Row)
＞ d = .Value
＞ ad = .Address
＞ End With
＞ If Not IsDate(d) Then Exit For
＞ Cancel = True
＞ If Weekday(d, vbMonday) > 5 Or _
＞ IsNumeric(Evaluate("Match(" & ad & ",'テーブル 1'!b:b,0)")) Then
＞ r.Value = "●"
＞ Else
＞ r.Value = "〇"
＞ End If
＞ Next
＞ Application.EnableEvents = True
＞ End Sub
＞
＞ Private Sub Worksheet_Change(ByVal Target As Range)
＞ If Target.Address(0, 0) = スタート Then
＞ If MsgBox("表をクリアしますか？", vbYesNo) = vbYes Then
＞ Application.EnableEvents = False
＞ Range(スタート).Offset(2).Resize(98, 31).ClearContents
＞ Application.EnableEvents = True
＞ End If
＞ End If
＞ End Sub
＞

[返信 8] Re : イベントプロシージャで平日〇土日祝●
投稿者 : mitsu isobe     投稿日時 : 2024/08/14(Wed) 16:44:31
■[返信 1] tekさん（2024-08-05 06:31:33）の記事
＞ 一例です。
＞ 事前準備
＞ データ　－　Web から　にてURLに
＞ https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
＞ を入れOK
＞ 左一覧からテーブル 1をクリックし、右にテーブル 1が表示されたら下の読み込みをクリック
＞ シートに一覧が表示され、そのシート名を違っていたら"テーブル 1"に変更
＞ "カレンダー"シートを作成し、そのシートタブを右クリックし、コードの表示(V)をクリック
＞ 以下のコードをコードペインに貼り付け「カレンダー作成」を実行
＞
＞ G3セルに開始日を入力
＞
＞
＞ 曜日表示の下の行から98行目までのセルを選択し、右クリックすると"〇"または"●"が表示されます
＞ Option Explicit
＞ Private Const スタート = "G3"
＞
＞ Private Sub カレンダー作成()
＞ Application.EnableEvents = False
＞ With Range(スタート)
＞ .Value = "1/1"
＞ .Offset(1).FormulaR1C1 = "=R[-1]C"
＞ .Offset(, 1).Resize(2, 30).FormulaR1C1 = "=RC[-1]+1"
＞ .Resize(, 31).NumberFormatLocal = "m月d日"
＞ .Offset(1).Resize(, 31).NumberFormatLocal = "aaaa"
＞ End With
＞ Application.EnableEvents = True
＞ End Sub
＞
＞ Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
＞ Dim r As Range
＞ Dim d
＞ Dim ad As String
＞ Set Target = Intersect(Target, Range(スタート).Offset(2).Resize(98, 31))
＞ If Target Is Nothing Then Exit Sub
＞ Application.EnableEvents = False
＞ For Each r In Target
＞ With r.EntireColumn.Rows(Range(スタート).Row)
＞ d = .Value
＞ ad = .Address
＞ End With
＞ If Not IsDate(d) Then Exit For
＞ Cancel = True
＞ If Weekday(d, vbMonday) > 5 Or _
＞ IsNumeric(Evaluate("Match(" & ad & ",'テーブル 1'!b:b,0)")) Then
＞ r.Value = "●"
＞ Else
＞ r.Value = "〇"
＞ End If
＞ Next
＞ Application.EnableEvents = True
＞ End Sub
＞
＞ Private Sub Worksheet_Change(ByVal Target As Range)
＞ If Target.Address(0, 0) = スタート Then
＞ If MsgBox("表をクリアしますか？", vbYesNo) = vbYes Then
＞ Application.EnableEvents = False
＞ Range(スタート).Offset(2).Resize(98, 31).ClearContents
＞ Application.EnableEvents = True
＞ End If
＞ End If
＞ End Sub
＞

当掲示板について
  • Excel VBA に関する掲示板です。Excel VBA に関する質問や疑問、それに対する解決方法など気軽に投稿してください。
  • 記事内ではHTMLのタグは使用できません。
  • 記事は一度投稿すると修正できません。内容を訂正したい場合は返信で対応してください。
  • Sub〜End Sub、Function〜End Function は自動的にプログラムコードとみなし、枠で囲って見やすくします。
  • Excel VBA とは関係ないことや、他人が不快に思うようなことなど、管理人が適当でないと判断した記事は削除する場合があります。
スポンサーリンク
返信入力フォーム
お　名　前　　：
内　　容　　　：

ステータス　　：

認証コード　　： キャプチャ画像 




( 処理日時 : 2025-07-06 04:30:27 )
タイトルとURLをコピーしました