본문 바로가기
일상/일상

매크로

by 시골갱얼쥐 2025. 5. 23.
반응형

오랜만에 엑셀 매크로를 좀 짰어요.

Sub ExportLecturesToPDF()
    Dim ws As Worksheet, tempWs As Worksheet, progressWs As Worksheet
    Dim lastRow As Long, i As Long, r As Long
    Dim dict As Object, key As Variant
    Dim year As String, semester As String, major As String
    Dim lecture As String, prof As String, mergedCode As String
    Dim savePath As String

    On Error GoTo ErrHandler

    Set ws = ThisWorkbook.Sheets("수강명단")

    ' 진행상황 시트 없으면 생성
    On Error Resume Next
    Set progressWs = ThisWorkbook.Sheets("진행상황")
    On Error GoTo ErrHandler
    If progressWs Is Nothing Then
        Set progressWs = ThisWorkbook.Sheets.Add
        progressWs.Name = "진행상황"
    End If
    progressWs.Range("A1").Value = "진행률을 기다려주세요..."

    Set dict = CreateObject("Scripting.Dictionary")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' 고유 키 생성
    For i = 2 To lastRow
        year = Trim(ws.Cells(i, 2).Value)
        semester = Trim(ws.Cells(i, 3).Value)
        major = Trim(ws.Cells(i, 5).Value)
        lecture = Trim(ws.Cells(i, 6).Value)
        prof = Trim(ws.Cells(i, 9).Value)
        mergedCode = Trim(ws.Cells(i, 8).Value)
        key = major & "|" & year & "|" & semester & "|" & lecture & "|" & prof & "|" & mergedCode
        If Not dict.exists(key) Then dict.Add key, ""
    Next i

    ' 기존 출력시트 삭제
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("출력시트").Delete
    Application.DisplayAlerts = True
    On Error GoTo ErrHandler

    Set tempWs = Worksheets.Add
    tempWs.Name = "출력시트"

    Dim countTotal As Long: countTotal = dict.Count
    Dim countDone As Long: countDone = 0

    For Each key In dict.Keys
        tempWs.Cells.ClearContents
        tempWs.Cells.Font.Size = 8

        ' 페이지 설정 (세로)
        With tempWs.PageSetup
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
            .LeftMargin = Application.CentimetersToPoints(0.5)
            .RightMargin = Application.CentimetersToPoints(0.5)
            .TopMargin = Application.CentimetersToPoints(1)
            .BottomMargin = Application.CentimetersToPoints(1)
        End With

        ' 헤더 출력
        tempWs.Range("A1:K1").Value = Array("연번", "개설 학년도", "개설 학기", "대학", "학과(전공)", "강좌명", "교수자성명", "학생 소속 학과(전공)", "학번", "성명", "성적")
        r = 2

        ' 해당 강의 필터링
        For i = 2 To lastRow
            If ws.Cells(i, 5).Value & "|" & ws.Cells(i, 2).Value & "|" & ws.Cells(i, 3).Value & "|" & ws.Cells(i, 6).Value & "|" & ws.Cells(i, 9).Value & "|" & ws.Cells(i, 8).Value = key Then
                tempWs.Cells(r, 1).Value = r - 1
                tempWs.Cells(r, 2).Value = ws.Cells(i, 2).Value
                tempWs.Cells(r, 3).Value = ws.Cells(i, 3).Value
                tempWs.Cells(r, 4).Value = ws.Cells(i, 4).Value
                tempWs.Cells(r, 5).Value = ws.Cells(i, 5).Value
                tempWs.Cells(r, 6).Value = ws.Cells(i, 6).Value
                tempWs.Cells(r, 7).Value = ws.Cells(i, 9).Value
                tempWs.Cells(r, 8).Value = ws.Cells(i, 11).Value
                tempWs.Cells(r, 9).Value = ws.Cells(i, 12).Value
                tempWs.Cells(r, 10).Value = ws.Cells(i, 13).Value
                tempWs.Cells(r, 11).Value = ws.Cells(i, 14).Value
                r = r + 1
            End If
        Next i

        ' 출력 데이터가 있을 경우만 PDF 생성
        If r > 2 Then
            Dim endRow As Long: endRow = r - 1

            With tempWs.Range("A1:K" & endRow).Borders
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With

            tempWs.Columns("A:K").AutoFit
            tempWs.PageSetup.PrintArea = "A1:K" & endRow

            Dim parts() As String
            parts = Split(key, "|")
            savePath = ThisWorkbook.Path & "\" & _
                       Replace(parts(0), "\", "_") & "_" & parts(1) & "_" & parts(2) & "_" & _
                       Replace(parts(3), "\", "_") & "_" & Replace(parts(4), "\", "_") & "_" & parts(5) & ".pdf"

            tempWs.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath
        End If

        countDone = countDone + 1
        Dim progressText As String
        progressText = "전체 진행률: " & Format(countDone / countTotal, "0%") & _
                       " (" & countDone & "/" & countTotal & ")"
        Application.StatusBar = progressText
        progressWs.Range("A1").Value = progressText
        DoEvents
    Next key

Cleanup:
    Application.StatusBar = False
    Application.DisplayAlerts = False
    On Error Resume Next
    tempWs.Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    MsgBox "✅ 모든 PDF 저장이 완료되었습니다!", vbInformation
    Exit Sub

ErrHandler:
    MsgBox "오류 발생: " & Err.Description, vbCritical
    Resume Cleanup
End Sub

이런 매크로를 짰는데, 덕분에 우리 사무실분들의 시간을 이틀정도 아끼게 되었어요. 정말 다행이에요. gpt 첨삭도 좀 받았는데 자꾸 스파게티처럼 코드를 만들어버려서 좀 힘들었습니다..

*

낙지도 얻어먹고 뼈다구 해장국도 얻어먹었는데 영 손해같네요. 돈받고 해야하는데 너무 나댔나 싶은 하루였습니다.

반응형

'일상 > 일상' 카테고리의 다른 글

원스핀  (0) 2025.05.25
좆비  (0) 2025.05.24
고귀하다?  (0) 2025.05.22
위선에 대한 고찰  (0) 2025.05.21
먹을 복  (0) 2025.05.20

댓글