주말, 법정공휴일, 대체공휴일이 적용된 달력

주말과 법정공휴일까지만 적용되어 혼자만 쓰고 있던 달력을

대체공휴일까지 적용되도록 수정했습니다.

대체공휴일 규칙을 어떻게 정하면 좋을까.. 고민고민을 하다가

의외로 간단하게 풀렸네요.

달력.xlsm

Option Base 1
Option Explicit
 
' ===================================================================
'
' A1 와 B1에 연, 월을 입력하면 기간에 맞춰서 달력이 수정됩니다.
' 연도는 1990 ~ 2030년 사이에서 선택 가능합니다. 데이터 유효성검사에서 수정 가능합니다.
' 주말, 공휴일, 대체공휴일이 강조됩니다. 대체공휴일은 2015 ~ 2029년까지 적용됩니다.
' 음력변환 코드는 인터넷에서 찾았습니다.
 
' *제작자 : 당근쨈(dorobo99@gmail.com)
' *홈페이지 : http://dorobo.tistory.com
' *제작일자 : 2016. 10. 28.(금)
' *수정, 배포는 자유롭습니다만, 위의 제작자 정보만 남겨주세요.
'
' ===================================================================
 
Sub MakeCalendar()
    
    Dim wsCal As Worksheet
    Dim vDate() As Variant
    Dim InputYear As Integer, InputMonth As Integer, Days As Integer
    Dim i As Integer
    Dim FirstDay As Range
    Dim rngDay As Range
    
    Call SpeedUp(False)
    
    '매크로에 필요한 변수 선언 구간
    '연도는 1990 ~ 2030년 선택 가능 : 데이터 유효성검사에서 조절 가능
    Set wsCal = Sheets("일정")
    Days = DateSerial(InputYear, InputMonth + 1, 1) - DateSerial(InputYear, InputMonth, 1)  '일수
    With wsCal
        Set FirstDay = .Range("D2") '일자 입력 시작셀
        InputYear = .Range("A1").Value2 '연
        InputMonth = .Range("B1").Value2    '월
    End With
    
    '데이터부분과과 달력 부분을 초기화합니다.
    With wsCal.Range("A1").CurrentRegion
        Union(.Offset(3), .Offset(, 3)).Clear
    End With
    
    '달력 및 요일 입력 후 배열초기화하여 배열 재활용
    ReDim vDate(2, Days)
    
    For i = 1 To Days
        vDate(1, i) = i
        vDate(2, i) = Format(DateSerial(InputYear, InputMonth, i), "aaa")
    Next i
    
    FirstDay.Resize(2, Days) = vDate
    Erase vDate
    
    '법정(양력, 음력) 공휴일과 대체공휴일을 배열에 삽입
    '음력 공휴일은 양력으로 변환하여 배열에 삽입
    '대체공휴일의 경우 규칙을 정해 강조를 하고자 하였으나
    '일수가 얼마 되지 않아 알고리즘을 짜는 것보다 하드코딩이 더 나은 것으로 판단되어
    '일자 하나하나를 배열에 삽입
    vDate = Array(DateSerial(InputYear, 1, 1), _
                        DateSerial(InputYear, 3, 1), _
                        DateSerial(InputYear, 5, 5), _
                        DateSerial(InputYear, 6, 6), _
                        DateSerial(InputYear, 8, 15), _
                        DateSerial(InputYear, 10, 3), _
                        DateSerial(InputYear, 10, 9), _
                        DateSerial(InputYear, 12, 25), _
                        Lun2Sol(InputYear, 1, 1, False) - 1, _
                        Lun2Sol(InputYear, 1, 1, False), _
                        Lun2Sol(InputYear, 1, 2, False), _
                        Lun2Sol(InputYear, 4, 8, False), _
                        Lun2Sol(InputYear, 8, 14, False), _
                        Lun2Sol(InputYear, 8, 15, False), _
                        Lun2Sol(InputYear, 8, 16, False), # _
                        9/29/2015#, #2/10/2016#, #1/30/2017#, #9/26/2018#, # _
                        5/7/2018#, #5/6/2019#, #1/27/2020#, #9/12/2022#, # _
                        1/24/2023#, #2/12/2024#, #5/6/2024#, #10/8/2025#, # _
                        2/9/2027#, #9/24/2029#, #5/7/2029#)
    
    '주말 강조
    For Each rngDay In FirstDay.Resize(, Days)
        With rngDay
            Select Case .Offset(1)
                Case "토", "일"
                    Call ChangeCell(.Resize(2))
            End Select
        End With
    Next rngDay
    
    '법정 및 대체공휴일 강조
    For i = 1 To UBound(vDate)
        If year(vDate(i)) = InputYear Then
            If Month(vDate(i)) = InputMonth Then
                Call ChangeCell(FirstDay.Offset(, Day(vDate(i)) - 1).Resize(2))
            End If
        End If
    Next i
    
    '가운데 정렬 및 열너비 자동설정 및 행높이 27
    With Range("A1").CurrentRegion
        .HorizontalAlignment = xlCenter
        .EntireColumn.AutoFit
        .RowHeight = 27
        .Offset(1).Resize(.Rows.Count - 1).Borders.LineStyle = xlContinuous
    End With
    
    Call SpeedUp(True)
 
End Sub
 
Sub ChangeCell(TargetCell As Range)
'주말 및 공휴일 서식 강조 프로시저
 
    With TargetCell
    
        With .Font
            .ColorIndex = 3
            .Bold = True
        End With
        
        .Interior.ColorIndex = 36
        
    End With
 
End Sub
 
Sub SpeedUp(Bool As Boolean)
'처리속도 조절 프로시저
 
    Dim AutoCal As Long
    
    Select Case Bool
    
        Case False
            AutoCal = xlCalculationManual
            
        Case True
            AutoCal = xlCalculationAutomatic
            
    End Select
 
    With Application
        .ScreenUpdating = Bool
        .EnableEvents = Bool
        .Calculation = AutoCal
    End With
    
End Sub