[유튜브] 동적만년달력 소스코드

엑셀퀘스트 스터디클럽 · 데이터위자드

안녕하세요 엑셀 자동화 전문가 데이터위자드입니다
이번 영상에서는 엑셀로 만드는 동적 만년달력 소스코드를 보여드립니다
스핀단추로 월 이동이 가능하고 일정이나 할 일 관리까지 연동되는 실전 예제입니다

[일반모듈]

Option Explicit

Sub MonthUp()
    Dim wsSet As Worksheet
    Set wsSet = ThisWorkbook.Sheets("SET")

    wsSet.Range("B2").Value = DateAdd("m", 1, wsSet.Range("B2").Value)
    Application.Calculate
    LoadCalendarFromDB
End Sub

Sub MonthDown()
    Dim wsSet As Worksheet
    Set wsSet = ThisWorkbook.Sheets("SET")

    wsSet.Range("B2").Value = DateAdd("m", -1, wsSet.Range("B2").Value)
    Application.Calculate
    LoadCalendarFromDB
End Sub




Sub LoadCalendarFromDB()
    Dim wsD As Worksheet, wsDB As Worksheet
    Dim c As Range, f As Range
    Dim dateVal As Date, i As Long
    Dim rowsArr, rowIdx As Variant
    Set wsD = ThisWorkbook.Sheets("DASH")
    Set wsDB = ThisWorkbook.Sheets("DB")
    Application.EnableEvents = False
    rowsArr = Array(2, 6, 10, 14, 18, 22)
    For Each rowIdx In rowsArr
        wsD.Range("B" & rowIdx + 1 & ":H" & rowIdx + 3).ClearContents
    Next rowIdx

    For Each rowIdx In rowsArr
        For Each c In wsD.Range("B" & rowIdx & ":H" & rowIdx)
            If IsDate(c.Value) Then
                dateVal = c.Value
                Set f = wsDB.Columns("A").Find(What:=dateVal, LookIn:=xlValues, LookAt:=xlWhole)
                If Not f Is Nothing Then
                    For i = 1 To 3
                        wsD.Cells(rowIdx + i, c.Column).Value = wsDB.Cells(f.Row, i + 1).Value
                    Next i
                End If
            End If
        Next c
    Next rowIdx

    Application.EnableEvents = True
End Sub

[DASH]시트 모듈

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsDB As Worksheet, dateCell As Range
    Dim dateVal As Variant, dataIndex As Integer, r As Long

    Set wsDB = ThisWorkbook.Sheets("DB")

    If Intersect(Target, Me.Range("B3:H25")) Is Nothing Then Exit Sub
    Application.EnableEvents = False

    For Each Target In Target
        Select Case True
            Case Target.Row >= 3 And Target.Row <= 5: Set dateCell = Cells(2, Target.Column)
            Case Target.Row >= 7 And Target.Row <= 9: Set dateCell = Cells(6, Target.Column)
            Case Target.Row >= 11 And Target.Row <= 13: Set dateCell = Cells(10, Target.Column)
            Case Target.Row >= 15 And Target.Row <= 17: Set dateCell = Cells(14, Target.Column)
            Case Target.Row >= 19 And Target.Row <= 21: Set dateCell = Cells(18, Target.Column)
            Case Target.Row >= 23 And Target.Row <= 25: Set dateCell = Cells(22, Target.Column)
            Case Else: Set dateCell = Nothing
        End Select

        If Not dateCell Is Nothing And IsDate(dateCell.Value) Then
            dateVal = dateCell.Value
            dataIndex = Target.Row - dateCell.Row

            If dataIndex >= 1 And dataIndex <= 3 Then
                On Error Resume Next
                r = Application.Match(CDbl(dateVal), wsDB.Range("A:A"), 0)
                On Error GoTo 0
                If r = 0 Then
                    r = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).Row + 1
                    wsDB.Cells(r, "A").Value = dateVal
                End If
                wsDB.Cells(r, dataIndex + 1).Value = Target.Value
            End If
        End If
    Next Target

    Application.EnableEvents = True
End Sub