Sub ExtractWeekendAndHolidayDatesByYear(yearToSearch As Integer)
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
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, 1, 1) ' 指定された年の1月1日を取得
endDate = DateSerial(yearToSearch, 12, 31) ' 指定された年の12月31日を取得
' 日本の祝日を配列に格納します(必要に応じて更新してください)
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 currentDate = startDate To 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
Next currentDate
End Sub
Sub TestExtractWeekendAndHolidayDatesByYear()
Dim yearToSearch As Integer
yearToSearch = InputBox("検索する年度を入力してください", "年度指定")
If IsNumeric(yearToSearch) Then
ExtractWeekendAndHolidayDatesByYear yearToSearch
Else
MsgBox "無効な入力です。数字を入力してください。"
End If
End Sub