マンガでよめる痔のこと・薬のこと

Excel2016 特定の曜日のみ表示するカレンダー(スケジュール表)を作成したいです。
添付のExcelファイルは、関数や表示形式の設定はしておりません。
下記の条件を満たす関数またはVBA(マクロ)のコードを、どなたか教えてください。

内訳
・添付ファイルでは、6月までしか表示されておりませんが、1つのシートに1月~12月まであります。
・A1の年度を変更したら、その年の各月の火曜日と木曜日の日にちのみを表示する。
・火曜日、または木曜日が祝日の場合は、繰り下げた日にちを表示する。
・会社の定休日は、土日祝日と12/31~1/3となります。
・同じブックの別シート(シート2)に、1年間の祝日と会社の定休日を入力し、名前の定義で「祝日等」にしております。

どうぞよろしくお願いいたします。

「Excel2016 特定の曜日のみ表示す」の質問画像

質問者からの補足コメント

  • うれしい

    tom04 様
    ご回答いただきまして、ありがとうございます。
    修正いただきましたコードにて、早速実行入力、実行させていただきました。
    第二火曜日の2行目、5月の大型連休も考慮したコードに修正いただいて、本当に感謝いたしております。
    ただ、12月のカレンダーに翌年の1月1日が表示されてしまいます。
    そちらについても、考慮していただくことは可能でしょうか?

    No.2の回答に寄せられた補足コメントです。 補足日時:2020/01/13 21:16

A 回答 (3件)

あ”~~~!



細かい検証をしていませんでした。
今までのコードは消去し
↓のコードにしてください。

尚、よく確認してみると第6週目がある曜日は日・月までなので
今回の場合、火・木限定というコトは結局5週間だけの処理で良かったですね。

Sub Sample3()
 Dim i As Long, k As Long, cnt As Long
 Dim myDay As Date
 Dim myR, myAry

  With Worksheets("Sheet1")
   myAry = Array("A4", "H4", "A12", "H12", "A20", "H20", "A28", "H28", "A36", "H36", "A44", "H44")
    For k = 0 To UBound(myAry)
     With .Range(myAry(k)).Offset(2).Resize(5)
      .NumberFormatLocal = "d日"
      .ClearContents
     End With
     With .Range(myAry(k)).Offset(2, 3).Resize(5)
      .NumberFormatLocal = "d日"
      .ClearContents
     End With
      .Range(myAry(k)).Offset(2, 3).Resize(5).ClearContents
      cnt = 1
      myR = .Range(myAry(k)).Offset(2).Resize(5, 4)
       For i = 1 To Day(WorksheetFunction.EoMonth(DateSerial(.Range("A1"), k + 1, 1), 0))
        myDay = DateSerial(.Range("A1"), k + 1, i)
         If WorksheetFunction.Weekday(myDay) = 7 Then
          cnt = cnt + 1
         End If
         If WorksheetFunction.Weekday(myDay) = 3 Then
          If WorksheetFunction.Weekday(WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))) <> 5 Then
           If Month(WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))) = k + 1 Then '//●//
            myR(cnt, 1) = WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))
           End If
          End If
         ElseIf WorksheetFunction.Weekday(myDay) = 5 Then
          If WorksheetFunction.Weekday(WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))) <> 3 Then
           If Month(WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))) = k + 1 Then '//●//
            myR(cnt, 4) = WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))
           End If
          End If
         End If
       Next i
      .Range(myAry(k)).Offset(2).Resize(5, 4) = myR
    Next k
  End With
End Sub

※ 「●」の部分を追加しています。
今度はどうでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

完璧です。
こんなに迅速かつ親切にご対応いただきまして、本当にうれしいです。
tom04さんには、以前もご回答いただいております。
いつも、私の質問を見つけてくださって、本当にありがとうございました。
また、よろしくお願いいたします。

お礼日時:2020/01/13 23:09

No.1です。



投稿後画像をもう一度よく見ると
第二火曜日は2行目!といった感じにしなくてはならないのですね。
そして、WORKDAY関数で火・木曜日を求めた場合
万一連休が続き火・木曜に重なる場合も考慮する必要があるようなので・・・
前回のコードはすべて消去し↓のコードに変更してください。

そして今回は6週にも対応しています。

Sub Sample2()
 Dim i As Long, k As Long, cnt As Long
 Dim myDay As Date
 Dim myR, myAry

  With Worksheets("Sheet1")
   myAry = Array("A4", "H4", "A12", "H12", "A20", "H20", "A28", "H28", "A36", "H36", "A44", "H44")
    For k = 0 To UBound(myAry)
     With .Range(myAry(k)).Offset(2).Resize(6) '//★//
      .NumberFormatLocal = "d日"
      .ClearContents
     End With
     With .Range(myAry(k)).Offset(2, 3).Resize(6) '//★
      .NumberFormatLocal = "d日"
      .ClearContents
     End With
      .Range(myAry(k)).Offset(2, 3).Resize(6).ClearContents '//★/
      cnt = 1
      myR = .Range(myAry(k)).Offset(2).Resize(6, 4) '//★//
       For i = 1 To Day(WorksheetFunction.EoMonth(DateSerial(.Range("A1"), k + 1, 1), 0))
        myDay = DateSerial(.Range("A1"), k + 1, i)
         '//▼ココから少し訂正//
         If WorksheetFunction.Weekday(myDay) = 7 Then
          cnt = cnt + 1
         End If
         If WorksheetFunction.Weekday(myDay) = 3 Then
          If WorksheetFunction.Weekday(WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))) <> 5 Then
           myR(cnt, 1) = WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))
          End If
         ElseIf WorksheetFunction.Weekday(myDay) = 5 Then
          If WorksheetFunction.Weekday(WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))) <> 3 Then
           myR(cnt, 4) = WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))
          End If
         End If
       Next i
       '//▲ココまで//
      .Range(myAry(k)).Offset(2).Resize(6, 4) = myR '//★//
      cnt = 1
    Next k
  End With
End Sub

今度はどうでしょうか?m(_ _)m
この回答への補足あり
    • good
    • 0
この回答へのお礼

tom04 様
ご回答いただきまして、ありがとうございます。
修正いただきましたコードにて、早速実行入力、実行させていただきました。
第二火曜日の2行目、5月の大型連休も考慮したコードに修正いただいて、本当に感謝いたしております。
ただ、12月のカレンダーに翌年の1月1日が表示されてしまいます。
そちらについても、考慮していただくことは可能でしょうか?

お礼日時:2020/01/13 21:29

こんばんは!



VBAになりますが、一例です。

尚、前提条件として、お示しのデータシート名は「Sheet1」とし
A1セルの書式設定は
ユーザー定義から
A1 → 0年
とし、単に2020という数値のみを入力しているとします。

標準モジュールです。

Sub Sample1()
 Dim i As Long, k As Long, cnt As Long
 Dim myDay As Date
 Dim myR, myAry

  With Worksheets("Sheet1")
   myAry = Array("A4", "H4", "A12", "H12", "A20", "H20", "A28", "H28", "A36", "H36", "A44", "H44")
    For k = 0 To UBound(myAry)
     With .Range(myAry(k)).Offset(2).Resize(5) '//★//
      .NumberFormatLocal = "d日"
      .ClearContents
     End With
     With .Range(myAry(k)).Offset(2, 3).Resize(5) '//★
      .NumberFormatLocal = "d日"
      .ClearContents
     End With
      .Range(myAry(k)).Offset(2, 3).Resize(5).ClearContents '//★/
      cnt = 1
      myR = .Range(myAry(k)).Offset(2).Resize(5, 4) '//★//
       For i = 1 To Day(WorksheetFunction.EoMonth(DateSerial(.Range("A1"), k + 1, 1), 0))
        myDay = DateSerial(.Range("A1"), k + 1, i)
         If WorksheetFunction.Weekday(myDay) = 3 Then
          myR(cnt, 1) = WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))
         ElseIf WorksheetFunction.Weekday(myDay) = 5 Then
          myR(cnt, 4) = WorksheetFunction.WorkDay(myDay - 1, 1, Range("祝日等"))
          cnt = cnt + 1
         End If
       Next i
      .Range(myAry(k)).Offset(2).Resize(5, 4) = myR '//★//
      cnt = 1
    Next k
  End With
End Sub

※ お示しの画像では1か月5週間限定となっているので
5行だけの操作にしていますが、まれに1か月が6週になる月もあるはずです。
6週間に対応するコードにしても良かったのですが、
画像の配置だと11行目・19行目・・・にデータがある場合そのデータも消えてしまいますので
画像通り5週間限定としています。

6週対応にしたい場合はコード内の「★」の行の
「5」を「6」に変更してみてください。m(_ _)m
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報