hiko-blog

VBA業務改善

MENU

日本の休日を考慮して土曜日と日曜日を検索

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