엑셀 직접 만드는 자동화달력 (1, 2번 코드)

Option Explicit

Public Sub 월증가()
    ChangeMonth 1
End Sub

Public Sub 월감소()
    ChangeMonth -1
End Sub

Private Sub ChangeMonth(ByVal monthOffset As Long)
    Dim previousEvents As Boolean
    Dim d As Date
    previousEvents = Application.EnableEvents
    On Error GoTo Failed
    Application.EnableEvents = False

    With ThisWorkbook.Worksheets("SET").Range("B2")
        If Not IsDate(.Value) Then
            Err.Raise 5, , "SET!B2에 날짜를 입력하세요."
        End If
        d = CDate(.Value)
        .Value = DateSerial(Year(d), Month(d) + monthOffset, 1)
    End With
    LoadCalendarFromDB

Done:
    Application.EnableEvents = previousEvents
    Exit Sub
Failed:
    MsgBox Err.Description, vbExclamation
    Resume Done
End Sub

Public Sub LoadCalendarFromDB()
    Dim dash As Worksheet, db As Worksheet
    Dim dateRows As Variant, rowNo As Variant
    Dim col As Long, slot As Long, hit As Variant
    Dim previousEvents As Boolean
    Dim errorNumber As Long, errorText As String

    previousEvents = Application.EnableEvents
    On Error GoTo Failed
    Application.EnableEvents = False
    Set dash = ThisWorkbook.Worksheets("DASH")
    Set db = ThisWorkbook.Worksheets("DB")
    dateRows = Array(2, 6, 10, 14, 18, 22)
    dash.Calculate

    For Each rowNo In dateRows
        dash.Cells(rowNo + 1, 2).Resize(3, 7).ClearContents
        For col = 2 To 8
            If IsDate(dash.Cells(rowNo, col).Value) Then
                hit = Application.Match( _
                    CDbl(CDate(dash.Cells(rowNo, col).Value)), _
                    db.Columns(1), 0)
                If Not IsError(hit) Then
                    For slot = 1 To 3
                        dash.Cells(rowNo + slot, col).Value2 = _
                            db.Cells(CLng(hit), slot + 1).Value2
                    Next slot
                End If
            End If
        Next col
    Next rowNo

Done:
    Application.EnableEvents = previousEvents
    If errorNumber <> 0 Then
        Err.Raise errorNumber, "LoadCalendarFromDB", errorText
    End If
    Exit Sub
Failed:
    errorNumber = Err.Number
    errorText = Err.Description
    Resume Done
End Sub

Public Sub SaveCalendarToDB(ByVal Target As Range)
    Dim dash As Worksheet, db As Worksheet
    Dim area As Range, cell As Range
    Dim dateRow As Long, slot As Long, dbRow As Long
    Dim d As Date, hit As Variant
    Dim previousEvents As Boolean
    Dim errorNumber As Long, errorText As String

    previousEvents = Application.EnableEvents
    On Error GoTo Failed
    Application.EnableEvents = False
    Set dash = ThisWorkbook.Worksheets("DASH")
    Set db = ThisWorkbook.Worksheets("DB")
    Set area = Intersect(Target, dash.Range("B3:H25"))
    If area Is Nothing Then GoTo Done

    For Each cell In area.Cells
        slot = (cell.Row - 2) Mod 4
        If slot >= 1 And slot <= 3 Then
            dateRow = cell.Row - slot
            If IsDate(dash.Cells(dateRow, cell.Column).Value) Then
                d = CDate(dash.Cells(dateRow, cell.Column).Value)
                hit = Application.Match(CDbl(d), db.Columns(1), 0)
                If IsError(hit) Then
                    dbRow = db.Cells(db.Rows.Count, 1).End(xlUp).Row + 1
                    db.Cells(dbRow, 1).Value = d
                    db.Cells(dbRow, 1).NumberFormat = "yyyy-mm-dd"
                Else
                    dbRow = CLng(hit)
                End If
                db.Cells(dbRow, slot + 1).Value2 = cell.Value2
            End If
        End If
    Next cell

Done:
    Application.EnableEvents = previousEvents
    If errorNumber <> 0 Then
        Err.Raise errorNumber, "SaveCalendarToDB", errorText
    End If
    Exit Sub
Failed:
    errorNumber = Err.Number
    errorText = Err.Description
    Resume Done
End Sub

2번 — 양방향 자동 저장

Option Explicit

Private Sub Workbook_Open()
    On Error GoTo Failed
    LoadCalendarFromDB
    Exit Sub
Failed:
    MsgBox Err.Description, vbExclamation
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Failed

    Select Case Sh.Name
        Case "DASH"
            If Not Intersect(Target, Sh.Range("B3:H25")) Is Nothing Then
                SaveCalendarToDB Target
            End If

        Case "DB"
            If Not Intersect(Target, Sh.Range("A:D")) Is Nothing Then
                LoadCalendarFromDB
            End If

        Case "SET"
            If Not Intersect(Target, Sh.Range("B2")) Is Nothing Then
                LoadCalendarFromDB
            End If
    End Select

    Exit Sub
Failed:
    MsgBox Err.Description, vbExclamation
End Sub