Excel2016 特定の曜日のみ表示するカレンダー（スケジュール表）を作成したいです

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

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

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

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

• 

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

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

No.3 ベストアンサー 回答者： tom04 回答日時： 2020/01/13 21:57

あ”～～～！

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

尚、よく確認してみると第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

この回答へのお礼

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

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

No.2 回答者： tom04 回答日時： 2020/01/13 21:02

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

この回答へのお礼

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

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

No.1 回答者： tom04 回答日時： 2020/01/13 20:33

こんばんは！

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