指定年、月と前後月 土日検索

Sub ExtractWeekendAndHolidayDatesByMonth(yearToSearch As Integer, monthToSearch As Integer)
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Variant
    Dim ws As Worksheet
    Dim rowNum As Long
    Dim holidayDates As Variant
    Dim i As Integer
    
    ' 新しいシートを作成します
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "WeekendAndHolidayDates" ' シートの名前を設定します
    
    ' ヘッダーを設定します
    ws.Range("A1").Value = "Date"
    ws.Range("B1").Value = "Day"
    
    ' 開始日と終了日を設定します
    startDate = DateSerial(yearToSearch, monthToSearch, 1) ' 指定された年月の1日を取得
    endDate = DateSerial(yearToSearch, monthToSearch + 1, 0) ' 指定された年月の最終日を取得
    
    ' 前月の開始日と終了日を設定します
    Dim prevMonthStartDate As Date
    Dim prevMonthEndDate As Date
    prevMonthStartDate = DateSerial(yearToSearch, monthToSearch - 1, 1)
    prevMonthEndDate = DateSerial(yearToSearch, monthToSearch, 0)
    
    ' 翌月の開始日と終了日を設定します
    Dim nextMonthStartDate As Date
    Dim nextMonthEndDate As Date
    nextMonthStartDate = DateSerial(yearToSearch, monthToSearch + 1, 1)
    nextMonthEndDate = DateSerial(yearToSearch, monthToSearch + 2, 0)
    
    ' 日本の祝日を配列に格納します（必要に応じて更新してください）
    holidayDates = Array("01/01", "01/02", "01/03", "02/11", "03/20", "04/29", "05/03", "05/04", "05/05", "07/18", "08/11", "09/19", "09/23", "10/10", "11/03", "11/23", "12/23")
    
    ' データを転記します
    rowNum = 2 ' データを書き込む最初の行を設定します
    For Each currentDate In Array(prevMonthStartDate, startDate, nextMonthStartDate)
        ' 開始日から終了日までループします
        Do While currentDate <= IIf(rowNum = 3, prevMonthEndDate, endDate)
            ' もし土曜日または日曜日であれば、その日付と曜日を書き込みます
            If Weekday(currentDate) = vbSaturday Or Weekday(currentDate) = vbSunday Then
                ws.Cells(rowNum, 1).Value = Format(currentDate, "yyyy/mm/dd") ' 日付を書き込みます
                ws.Cells(rowNum, 2).Value = WeekdayName(Weekday(currentDate)) ' 曜日を書き込みます
                rowNum = rowNum + 1 ' 次の行に移動します
            End If
            
            ' 日本の祝日をチェックして、祝日であればその日付と曜日を書き込みます
            For i = LBound(holidayDates) To UBound(holidayDates)
                If Format(currentDate, "mm/dd") = holidayDates(i) Then
                    ws.Cells(rowNum, 1).Value = Format(currentDate, "yyyy/mm/dd") ' 日付を書き込みます
                    ws.Cells(rowNum, 2).Value = "Holiday" ' 曜日を"Holiday"と書き込みます
                    rowNum = rowNum + 1 ' 次の行に移動します
                End If
            Next i
            
            ' 次の日付に移動します
            currentDate = currentDate + 1
        Loop
    Next currentDate
End Sub

Sub TestExtractWeekendAndHolidayDatesByMonth()
    Dim yearToSearch As Integer
    Dim monthToSearch As Integer
    yearToSearch = InputBox("検索する年を入力してください", "年指定")
    monthToSearch = InputBox("検索する月を入力してください", "月指定")
    
    If IsNumeric(yearToSearch) And IsNumeric(monthToSearch) Then
        If monthToSearch >= 1 And monthToSearch <= 12 Then
            ExtractWeekendAndHolidayDatesByMonth yearToSearch, monthToSearch
        Else
            MsgBox "無効な月です。1から12までの数字を入力してください。"
        End If
    Else
        MsgBox "無効な入力です。数字を入力してください。"
    End If
End Sub