================================================================================
   VBA 코드 라이브러리 — 보험설계 업무 자동화 10선
   챗GPT 활용 엑셀 실무능력 강화 강의 부속 자료
   작성: 이신우 (두온교육(주) / 미래이음연구소) · 2026.05.20
================================================================================

▶ 사용 방법
   1. Alt + F11 → VBA 편집기 열기
   2. [삽입] → [모듈] 클릭
   3. 아래 코드 중 필요한 부분을 복사·붙여넣기
   4. F5 또는 [실행] 버튼으로 매크로 실행
   ※ 매크로 사용 가능 통합문서(.xlsm)로 저장 필수

================================================================================
   01. 만기 임박 고객 자동 추출 (실습 ⑤)
================================================================================

Sub ExtractExpiringContracts()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, i As Long, dstRow As Long
    Dim daysLeft As Long
    Dim today As Date

    today = Date
    Set wsSrc = ThisWorkbook.Sheets("계약내역")

    ' 기존 시트 있으면 삭제
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("만기임박").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' 새 시트 생성 + 헤더 복사
    Set wsDst = ThisWorkbook.Sheets.Add(After:=wsSrc)
    wsDst.Name = "만기임박"
    wsSrc.Rows(1).Copy Destination:=wsDst.Rows(1)
    wsDst.Cells(1, 14).Value = "남은일수"  ' 추가 컬럼

    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
    dstRow = 2

    For i = 2 To lastRow
        If IsDate(wsSrc.Cells(i, 9).Value) Then
            daysLeft = wsSrc.Cells(i, 9).Value - today
            If daysLeft >= 0 And daysLeft <= 30 Then
                wsSrc.Rows(i).Copy Destination:=wsDst.Rows(dstRow)
                wsDst.Cells(dstRow, 14).Value = daysLeft

                ' D-7 이내는 빨간색 강조
                If daysLeft <= 7 Then
                    wsDst.Range(wsDst.Cells(dstRow, 1), wsDst.Cells(dstRow, 14)).Interior.Color = RGB(255, 200, 200)
                End If
                dstRow = dstRow + 1
            End If
        End If
    Next i

    ' 남은일수 오름차순 정렬
    If dstRow > 2 Then
        wsDst.Range(wsDst.Cells(2, 1), wsDst.Cells(dstRow - 1, 14)).Sort _
            Key1:=wsDst.Columns(14), Order1:=xlAscending, Header:=xlNo
    End If

    wsDst.Columns.AutoFit
    MsgBox "만기 임박 고객 " & (dstRow - 2) & "건 추출 완료!", vbInformation
End Sub


================================================================================
   02. DM 발송명단 자동 생성 (실습 ⑥)
================================================================================

Sub GenerateDMList()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, i As Long, dstRow As Long
    Dim signDate As Date
    Dim grade As String
    Dim newWb As Workbook
    Dim savePath As String

    Set wsSrc = ThisWorkbook.Sheets("고객명단")
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

    ' 새 통합문서 생성
    Set newWb = Workbooks.Add
    Set wsDst = newWb.Sheets(1)
    wsDst.Name = "DM명단_" & Format(Date, "yyyymmdd")

    ' 헤더 복사
    wsSrc.Rows(1).Copy Destination:=wsDst.Rows(1)
    dstRow = 2

    For i = 2 To lastRow
        signDate = wsSrc.Cells(i, 11).Value
        grade = wsSrc.Cells(i, 12).Value

        ' 조건: 가입 1년 이상 + 등급 우수 이상
        If (Date - signDate) >= 365 And (grade = "VIP" Or grade = "우수") Then
            wsSrc.Rows(i).Copy Destination:=wsDst.Rows(dstRow)
            dstRow = dstRow + 1
        End If
    Next i

    wsDst.Columns.AutoFit

    ' 파일 자동 저장
    savePath = ThisWorkbook.Path & "\DM_" & Format(Date, "yyyymmdd") & ".xlsx"
    Application.DisplayAlerts = False
    newWb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True

    MsgBox "DM 명단 " & (dstRow - 2) & "건 생성 완료!" & vbCrLf & _
           "저장 위치: " & savePath, vbInformation
End Sub


================================================================================
   03. 월간 활동보고서 자동 생성 (실습 ⑦)
================================================================================

Sub GenerateMonthlyReport()
    Dim wsSrc As Worksheet, wsRpt As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Object
    Dim designer As String
    Dim reportName As String

    Set dict = CreateObject("Scripting.Dictionary")
    Set wsSrc = ThisWorkbook.Sheets("활동일지")
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

    ' 설계사별 활동 건수 집계
    For i = 2 To lastRow
        designer = CStr(wsSrc.Cells(i, 3).Value)
        If dict.Exists(designer) Then
            dict(designer) = dict(designer) + 1
        Else
            dict(designer) = 1
        End If
    Next i

    ' 보고서 시트 생성
    reportName = "월간보고서_" & Format(Date, "yyyymm")
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets(reportName).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsRpt = ThisWorkbook.Sheets.Add(After:=wsSrc)
    wsRpt.Name = reportName

    ' 헤더
    wsRpt.Cells(1, 1).Value = "월간 활동 보고서 (" & Format(Date, "yyyy년 mm월") & ")"
    wsRpt.Cells(1, 1).Font.Size = 16
    wsRpt.Cells(1, 1).Font.Bold = True

    wsRpt.Cells(3, 1).Value = "설계사"
    wsRpt.Cells(3, 2).Value = "활동 건수"
    wsRpt.Range("A3:B3").Interior.Color = RGB(20, 40, 160)
    wsRpt.Range("A3:B3").Font.Color = RGB(255, 255, 255)
    wsRpt.Range("A3:B3").Font.Bold = True

    Dim row As Long
    row = 4
    Dim key As Variant
    For Each key In dict.Keys
        wsRpt.Cells(row, 1).Value = key
        wsRpt.Cells(row, 2).Value = dict(key)
        row = row + 1
    Next key

    ' 합계
    wsRpt.Cells(row, 1).Value = "합계"
    wsRpt.Cells(row, 2).Formula = "=SUM(B4:B" & (row - 1) & ")"
    wsRpt.Range(wsRpt.Cells(row, 1), wsRpt.Cells(row, 2)).Font.Bold = True
    wsRpt.Range(wsRpt.Cells(row, 1), wsRpt.Cells(row, 2)).Interior.Color = RGB(234, 240, 255)

    wsRpt.Columns.AutoFit
    MsgBox "월간 보고서 생성 완료!", vbInformation
End Sub


================================================================================
   04. 전화번호 형식 통일
================================================================================

Sub NormalizePhoneNumbers()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim raw As String, digits As String

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        raw = CStr(ws.Cells(i, 6).Value)  ' F열: 전화번호
        digits = ""

        ' 숫자만 추출
        Dim ch As String, k As Long
        For k = 1 To Len(raw)
            ch = Mid(raw, k, 1)
            If ch >= "0" And ch <= "9" Then digits = digits & ch
        Next k

        ' +82 처리
        If Left(digits, 2) = "82" And Len(digits) = 12 Then
            digits = "0" & Mid(digits, 3)
        End If

        ' 010-XXXX-XXXX 형식으로
        If Len(digits) = 11 Then
            ws.Cells(i, 6).Value = Left(digits, 3) & "-" & Mid(digits, 4, 4) & "-" & Right(digits, 4)
        End If
    Next i

    MsgBox "전화번호 형식 통일 완료!", vbInformation
End Sub


================================================================================
   05. 중복 고객 식별 + 백업
================================================================================

Sub DetectDuplicateCustomers()
    Dim ws As Worksheet, wsBak As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Object
    Dim key As String

    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Sheets("고객명단")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' 백업 시트
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("고객명단_백업").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    ws.Copy After:=ws
    Set wsBak = ActiveSheet
    wsBak.Name = "고객명단_백업"
    ws.Activate

    ' 중복 표시 (고객명 + 생년월일)
    For i = 2 To lastRow
        key = CStr(ws.Cells(i, 2).Value) & "|" & CStr(ws.Cells(i, 4).Value)
        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
            ws.Cells(i, 13).Value = "중복-" & dict(key)
            ws.Cells(i, 13).Interior.Color = RGB(255, 230, 200)
        Else
            dict(key) = 1
            ws.Cells(i, 13).Value = "원본"
        End If
    Next i

    MsgBox "중복 식별 완료! 백업 시트도 생성되었습니다.", vbInformation
End Sub


================================================================================
   06. 월별 시트 자동 분할
================================================================================

Sub SplitByMonth()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, i As Long
    Dim monthKey As String
    Dim dict As Object

    Set dict = CreateObject("Scripting.Dictionary")
    Set wsSrc = ThisWorkbook.Sheets("월간실적_3개월")
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        If IsDate(wsSrc.Cells(i, 1).Value) Then
            monthKey = Format(wsSrc.Cells(i, 1).Value, "yyyy-mm")

            ' 시트 없으면 생성
            If Not dict.Exists(monthKey) Then
                Application.DisplayAlerts = False
                On Error Resume Next
                ThisWorkbook.Sheets(monthKey).Delete
                On Error GoTo 0
                Application.DisplayAlerts = True

                Set wsDst = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                wsDst.Name = monthKey
                wsSrc.Rows(1).Copy Destination:=wsDst.Rows(1)
                dict(monthKey) = 2
            End If

            wsSrc.Rows(i).Copy Destination:=ThisWorkbook.Sheets(monthKey).Rows(dict(monthKey))
            dict(monthKey) = dict(monthKey) + 1
        End If
    Next i

    MsgBox "월별 시트 분할 완료! (" & dict.Count & "개 시트 생성)", vbInformation
End Sub


================================================================================
   07. 자동 백업 (현재 통합문서)
================================================================================

Sub BackupCurrentWorkbook()
    Dim savePath As String
    Dim baseName As String
    Dim wb As Workbook

    Set wb = ThisWorkbook
    baseName = Left(wb.Name, InStrRev(wb.Name, ".") - 1)
    savePath = wb.Path & "\" & baseName & "_백업_" & _
               Format(Now, "yyyymmdd_hhnnss") & ".xlsm"

    Application.DisplayAlerts = False
    wb.SaveCopyAs Filename:=savePath
    Application.DisplayAlerts = True

    MsgBox "백업 완료!" & vbCrLf & savePath, vbInformation
End Sub

' ▶ 통합문서 종료 시 자동 백업하려면 'ThisWorkbook' 모듈에 추가:
'
'   Private Sub Workbook_BeforeClose(Cancel As Boolean)
'       Call BackupCurrentWorkbook
'   End Sub


================================================================================
   08. 색상별 행 추출 (노란색 행만)
================================================================================

Sub ExtractYellowRows()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, i As Long, dstRow As Long
    Const YELLOW As Long = 65535  ' RGB(255,255,0)

    Set wsSrc = ActiveSheet

    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("노란색추출").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsDst = ThisWorkbook.Sheets.Add(After:=wsSrc)
    wsDst.Name = "노란색추출"
    wsSrc.Rows(1).Copy Destination:=wsDst.Rows(1)

    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
    dstRow = 2

    For i = 2 To lastRow
        If wsSrc.Cells(i, 1).Interior.Color = YELLOW Then
            wsSrc.Rows(i).Copy Destination:=wsDst.Rows(dstRow)
            dstRow = dstRow + 1
        End If
    Next i

    MsgBox "노란색 행 " & (dstRow - 2) & "건 추출 완료!", vbInformation
End Sub


================================================================================
   09. 폴더 내 다중 파일 통합
================================================================================

Sub ConsolidateFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim wbSrc As Workbook, wbTgt As Workbook
    Dim wsTgt As Worksheet
    Dim lastRow As Long, srcLastRow As Long
    Dim firstFile As Boolean

    folderPath = ThisWorkbook.Path & "\통합대상\"
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "통합대상 폴더가 없습니다: " & folderPath, vbExclamation
        Exit Sub
    End If

    Set wbTgt = ThisWorkbook
    Set wsTgt = wbTgt.Sheets.Add(After:=wbTgt.Sheets(wbTgt.Sheets.Count))
    wsTgt.Name = "통합_" & Format(Now, "hhnnss")
    firstFile = True

    fileName = Dir(folderPath & "*.xlsx")
    Application.ScreenUpdating = False
    Do While fileName <> ""
        Set wbSrc = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        srcLastRow = wbSrc.Sheets(1).Cells(wbSrc.Sheets(1).Rows.Count, 1).End(xlUp).Row

        If firstFile Then
            wbSrc.Sheets(1).Rows(1).Copy Destination:=wsTgt.Rows(1)
            wsTgt.Cells(1, wsTgt.Cells(1, wsTgt.Columns.Count).End(xlToLeft).Column + 1).Value = "원본파일"
            firstFile = False
        End If

        lastRow = wsTgt.Cells(wsTgt.Rows.Count, 1).End(xlUp).Row + 1
        If srcLastRow >= 2 Then
            wbSrc.Sheets(1).Range(wbSrc.Sheets(1).Cells(2, 1), _
                wbSrc.Sheets(1).Cells(srcLastRow, wbSrc.Sheets(1).UsedRange.Columns.Count)) _
                .Copy Destination:=wsTgt.Cells(lastRow, 1)

            Dim addedRows As Long
            addedRows = srcLastRow - 1
            Dim lastCol As Long
            lastCol = wsTgt.Cells(1, wsTgt.Columns.Count).End(xlToLeft).Column
            wsTgt.Range(wsTgt.Cells(lastRow, lastCol), wsTgt.Cells(lastRow + addedRows - 1, lastCol)).Value = fileName
        End If

        wbSrc.Close SaveChanges:=False
        fileName = Dir
    Loop
    Application.ScreenUpdating = True

    MsgBox "파일 통합 완료!", vbInformation
End Sub


================================================================================
   10. 보장분석표 자동 생성 (응용 과제)
================================================================================

Sub GenerateCoverageAnalysis()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim custNo As String
    Dim lastRow As Long, i As Long
    Dim sumSahmang As Double, sumSanghae As Double
    Dim sumUiryo As Double, sumYeongeum As Double

    custNo = InputBox("고객번호를 입력하세요 (예: C0001)", "보장분석표 생성")
    If custNo = "" Then Exit Sub

    Set wsSrc = ThisWorkbook.Sheets("계약내역")
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        If wsSrc.Cells(i, 2).Value = custNo Then
            Select Case wsSrc.Cells(i, 5).Value
                Case "종신보험", "정기보험", "CI보험"
                    sumSahmang = sumSahmang + wsSrc.Cells(i, 7).Value
                Case "건강보험", "암보험", "실손보험"
                    sumUiryo = sumUiryo + wsSrc.Cells(i, 7).Value
                Case "어린이보험"
                    sumSanghae = sumSanghae + wsSrc.Cells(i, 7).Value
                Case "연금보험", "변액연금", "저축보험"
                    sumYeongeum = sumYeongeum + wsSrc.Cells(i, 7).Value
            End Select
        End If
    Next i

    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("보장분석_" & custNo).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsDst = ThisWorkbook.Sheets.Add
    wsDst.Name = "보장분석_" & custNo

    wsDst.Cells(1, 1).Value = "고객번호 " & custNo & " 보장분석표"
    wsDst.Cells(1, 1).Font.Size = 14
    wsDst.Cells(1, 1).Font.Bold = True

    wsDst.Range("A3").Value = "보장 영역"
    wsDst.Range("B3").Value = "총 가입금액"
    wsDst.Range("A3:B3").Interior.Color = RGB(20, 40, 160)
    wsDst.Range("A3:B3").Font.Color = RGB(255, 255, 255)
    wsDst.Range("A3:B3").Font.Bold = True

    wsDst.Cells(4, 1).Value = "사망보장": wsDst.Cells(4, 2).Value = sumSahmang
    wsDst.Cells(5, 1).Value = "상해보장": wsDst.Cells(5, 2).Value = sumSanghae
    wsDst.Cells(6, 1).Value = "의료보장": wsDst.Cells(6, 2).Value = sumUiryo
    wsDst.Cells(7, 1).Value = "연금/저축": wsDst.Cells(7, 2).Value = sumYeongeum
    wsDst.Cells(8, 1).Value = "총 합계": wsDst.Cells(8, 2).Formula = "=SUM(B4:B7)"
    wsDst.Range("B4:B8").NumberFormat = "#,##0"
    wsDst.Range("A8:B8").Font.Bold = True
    wsDst.Range("A8:B8").Interior.Color = RGB(234, 240, 255)
    wsDst.Columns.AutoFit

    MsgBox "보장분석표 생성 완료!", vbInformation
End Sub


================================================================================
   ▶ 보안 안내
================================================================================

1. 본 코드는 가상 데이터를 전제로 작성되었습니다.
2. 실제 고객 정보는 사내 정책에 따라 처리해야 합니다.
3. 매크로 실행 전 반드시 백업을 권장합니다.
4. 외부 파일 통합 시 파일 출처를 확인하세요.

================================================================================
   문의: 이신우 (두온교육) · 010-3343-4000 · mintorain@gmail.com
================================================================================