VBA 振替休日

holiday.vba

Function IsHoliday(holidayCollection As Collection, day As Date) As Boolean
  IsHoliday = False
  Dim index as long
  Dim holiday as Date
  For index = 1 to holidayCollection.Count
    holiday = holidayCollection.Item(index)
    If holiday = day Then
    IsHoliday = True
    Exit For
    End if
  Next index
End Function

Sub Button1_Click()

  Dim currentYear As Integer
  currentYear = Year(Now)

  Dim firstRow As Integer
  Dim firstColumn As Integer
  firstRow = 3
  firstColumn = 2 ' B

  ' holidaySheet を取得する
  Dim holidaySheet As Worksheet
  Set holidaySheet = ThisWorkbook.Worksheets("holiday")

  ' holidayCollection を作成する
  Dim holidayCollection As Collection
  Set holidayCollection = New Collection
  Dim lastRow As Long
  Dim i As Long
  lastRow = holidaySheet.Cells(Rows.Count, 1).End(xlUp).Row
  ' holidaySheet から一つづつ cell を取得して、holidayCollection に代入
  For i = 2 To lastRow
    holidayCollection.Add item := holidaySheet.Cells(i, 1).Value
  Next i
  ' holidayCollection の作成終わり

  Dim index As Integer ' index は 1 ~ 12
  Dim currentMonth As Integer
  Dim currentRow As Integer
  For index = 1 To 12
    ' index: 1 → currentRow: 3
    ' index: 2 → currentRow: 4
    currentRow = firstRow + index - 1
    ' index: 1 → currentMonth: 4
    ' index: 2 → currentMonth: 5
    currentMonth = index + 3


    Dim day1 As Date
    Dim day2 As Date
    Dim day3 As Date
    Dim day4 As Date
    Dim day5 As Date
    Dim day6 As Date

    Dim holidayRange As Range
    Set holidayRange = ThisWorkbook.Worksheets("holiday").Range("A:A")

    day1 = DateSerial(currentYear, currentMonth, 27)
    If IsHoliday(holidayCollection, day1) Or Weekday(day1) = 1 Or Weekday(day1) = 7 Then
      day1 = WorksheetFunction.WorkDay(day1, 1, holidayRange)
    End If

    day2 = DateSerial(currentYear, currentMonth, 25)
    If IsHoliday(holidayCollection, day2) Or Weekday(day2) = 1 Or Weekday(day2) = 7 Then
      day2 = WorksheetFunction.WorkDay(day2, 1, holidayRange)
    End If

    day3 = DateSerial(currentYear, currentMonth + 1, 6)
    If IsHoliday(holidayCollection, day3) Or Weekday(day3) = 1 Or Weekday(day3) = 7 Then
      day3 = WorksheetFunction.WorkDay(day3, 1, holidayRange)
    End If

    day4 = DateSerial(currentYear, currentMonth + 1, 9)
    If IsHoliday(holidayCollection, day4) Or Weekday(day4) = 1 Or Weekday(day4) = 7 Then
      day4 = WorksheetFunction.WorkDay(day4, 1, holidayRange)
    End If

    day5 = DateSerial(currentYear, currentMonth + 1, 6)
    If IsHoliday(holidayCollection, day5) Or Weekday(day5) = 1 Or Weekday(day5) = 7 Then
      day5 = WorksheetFunction.WorkDay(day5, 1, holidayRange)
    End If

    day6 = DateSerial(currentYear, currentMonth + 1, 12)
    If IsHoliday(holidayCollection, day6) Or Weekday(day6) = 1 Or Weekday(day6) = 7 Then
      day6 = WorksheetFunction.WorkDay(day6, 1, holidayRange)
    End If

    Cells(currentRow, firstColumn) = day1
    Cells(currentRow, firstColumn + 1) = day2
    Cells(currentRow, firstColumn + 2) = day3
    Cells(currentRow, firstColumn + 3) = day4
    Cells(currentRow, firstColumn + 4) = day5
    Cells(currentRow, firstColumn + 5) = day6
  Next index
End Sub