엑셀 모든 버전에서 가능한, VLOOKUP 함수 완벽 자동화 | 10초면 됩니다

Public Enum ePrintMargin: xlNone = 0: xlNarrow = 1: xlNormal = 2: xlWide = 3: End Enum
Public Enum ePaperSize: xlA4 = 9: xlA3 = 8: xlLetter = 1: xlA5 = 11: End Enum
 
'-------------------------------------------------
 
Sub 엑셀파일로저장()
'여기를 선택 후, F5키를 누르면 각 시트를 나누어 저장합니다.
 
Dim Path As String: Path = GetFolderPath
If Path = "" Then MsgBox "올바른 폴더 경로를 선택하세요.": Exit Sub
 
Save_EachWS Path
 
MsgBox "파일 저장을 완료했습니다."
 
End Sub
 
Sub PDF로저장()
'여기를 선택 후 F5키를 누르면 각 시트를 PDF 파일로 저장합니다.
 
Dim Path As String: Path = GetFolderPath: Dim WS As Worksheet
Dim 우측머리글 As String: Dim 좌측머리글 As String: Dim 좌측바닥글 As String: Dim 우측바닥글 As String
Dim 가로중앙맞춤 As Boolean: Dim 세로중앙맞춤 As Boolean: Dim 인쇄방향 As XlPageOrientation
If Path = "" Then MsgBox "올바른 폴더 경로를 선택하세요.": Exit Sub
 
For Each WS In ThisWorkbook.Worksheets
    '설정영역
    좌측머리글 = WS.Name
    우측머리글 = "&D / &T"
    좌측바닥글 = "본 페이지의 무단복제를 금합니다."
    우측바닥글 = "&P / &N 페이지"
    가로중앙맞춤 = True
    세로중앙맞춤 = True
    인쇄방향 = xlPortrait  '가로방향 : xlLandScape
 
    WS.Activate
    Page_Setup WS, WS.Name, 우측머리글, 좌측바닥글, 우측바닥글, , , 가로중앙맞춤, 세로중앙맞춤, , 인쇄방향
    Rng_To_Pdf WS.UsedRange, WS.Name, Path, , , , False
Next
 
MsgBox "PDF 저장을 완료했습니다."
 
End Sub
 
'----------------------------------------------------
 
Sub Save_EachWS(Optional SavePath As String, Optional SheetName As String, Optional isOverWrite As Boolean = False, Optional ExcludeSheets As String)
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Save_EachWS 함수
'▶ 각 시트를 각각의 통합문서로 나누어 저장합니다.
'▶ 인수 설명
'_____________SavePath      : 시트를 나누어 통합문서로 저장할 폴더경로입니다. 기본값은 실행중인 통합문서와 동일한 경로입니다.
'_____________isOverWrite   : 덮어쓰기 여부입니다. 기본값은 False 입니다.
'_____________ExcludeSheets : 시트 나누기에서 제외할 시트입니다. 쉼표로 나누어 여러개 시트를 지정할 수 있습니다.
'▶ 보조 명령문 안내 : FileExist, FileSequence 함수
'###############################################################
 
Dim WS As Worksheet
Dim fPath As String
Dim vSheets As Variant: Dim vSheet As Variant
 
If SavePath = "" Then SavePath = Application.ActiveWorkbook.Path
If ExcludeSheets <> "" Then vSheets = Split(ExcludeSheets, ",")
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
For Each WS In ThisWorkbook.Sheets
    If ExcludeSheets <> "" Then
        For Each vSheet In vSheets
            If WS.Name = Trim(vSheet) Then
                GoTo Pass:
            End If
        Next
    End If
 
    WS.Copy
    If Right(SavePath, 1) <> "\" Then SavePath = SavePath & "\"
    fPath = SavePath & WS.Name & ".xlsx"
    If FileExists(fPath) And isOverWrite = False Then
        fPath = FileSequence(fPath)
    End If
    Application.ActiveWorkbook.SaveAs FileName:=fPath
    If SheetName <> "" Then Application.ActiveWorkbook.Worksheets(1).Name = SheetName
    Application.ActiveWorkbook.Close True
Pass:
Next
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
 
Public Function FileExists(ByVal path_ As String) As Boolean
 
'########################################################
'입력한 파일경로에 파일 존재여부를 확인합니다.
'https://www.oppadu.com/vba-fileexists-함수/
'########################################################
 
    FileExists = (Dir(path_, vbDirectory) <> "")
 
End Function
 
 
Private Function FileSequence(FilePath As String, Optional Sequence As Long = 1, Optional Delimiter As String = "-") As String
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ FileSequence 함수
'▶ 기존 파일이 존재할 경우 순번을 매겨 파일을 저장합니다.
'▶ 인수 설명
'_____________FilePath  : 확장자를 포함한 파일 경로입니다.
'_____________Sequence  : 순번을 매길 시작번호입니다.
'_____________Delimiter : 파일명과 순번을 구분할 구분자입니다.
'▶ 보조 명령문 안내 : FileExist 함수
'###############################################################
 
Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long
 
Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)
 
newPath = Path & Delimiter & Sequence & Ext
 
Do Until FileExists(newPath) = False
    Sequence = Sequence + 1
    newPath = Path & Delimiter & Sequence & Ext
Loop
 
FileSequence = newPath
 
End Function
 
Function GetFolderPath()
 
 
Dim FldrPicker As FileDialog
Dim fPath As String
 
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
 
  With FldrPicker
    .Title = "시트를 저장할 폴더를 선택하세요."
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Function
    fPath = .SelectedItems(1) & "\"
  End With
 
GetFolderPath = fPath
 
End Function
 
 
Public Function GetDesktopPath(Optional BackSlash As Boolean = True)
 
Dim oWSHShell As Object
 
Set oWSHShell = CreateObject("WScript.Shell")
 
If BackSlash = True Then
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop") & "\"
Else
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop")
End If
 
Set oWSHShell = Nothing
 
End Function
 
 
Function ValidFileName(ByVal FileName As String) As Boolean
 
Dim Arr As Variant: Dim Val As Variant
Dim Pnt As Long
 
Arr = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
 
If InStr(1, FileName, ":\") > 0 Then
    Pnt = InStrRev(FileName, "\")
    FileName = Right(FileName, Len(FileName) - Pnt)
End If
 
ValidFileName = True
 
For Each Val In Arr
    If InStr(1, FileName, Val) > 0 Then ValidFileName = False: Exit Function
Next
 
End Function
 
Function getPrintMargin(eValue As ePrintMargin) As Variant
 
'// 설정된 eNum 값으로 페이지 여백설정을 위한 값을 배열로 나열합니다.
 
Select Case eValue
Case 0
getPrintMargin = Array(0.05, 0.05, 0.05, 0.05, 0.1, 0.1)
Case 1
getPrintMargin = Array(0.25, 0.25, 0.75, 0.75, 0.3, 0.3)
Case 2
getPrintMargin = Array(0.7, 0.7, 0.75, 0.75, 0.3, 0.3)
Case 3
getPrintMargin = Array(1, 1, 1, 1, 0.5, 0.5)
End Select
 
End Function
 
Sub Page_Setup(WS As Worksheet, Optional LHead As String = "", Optional RHead As String = "&D / &T", _
Optional LFoot As String = "본 페이지의 무단복제를 금합니다.", Optional RFoot As String = "&P / &N 페이지", _
Optional eMargin As ePrintMargin = xlNarrow, _
Optional HFit As Boolean = True, Optional VFit As Boolean = False, _
Optional HCenter As Boolean = True, Optional VCenter As Boolean = False, _
Optional eOrient As XlPageOrientation = xlPortrait, Optional eSize As ePaperSize = xlA4)
 
Dim pSetup As String
Dim varMargin As Variant
Dim lngOrient As Integer
 
'// 인쇄설정 업데이트 중단 (속도증가)
Application.PrintCommunication = False
 
'// 인쇄여백값을 받아옵니다.
varMargin = getPrintMargin(eMargin)
 
'// 인쇄용지 방향을 설정합니다.
If eOrient = xlPortrait Then
lngOrient = 1
Else
lngOrient = 2
End If
 
'// ExecuteExcel4Macro 의 Page.Setup 명령문 실행을 위한 문구를 입력합니다.
Head = """&L" & LHead & "&R" & RHead & """"     '// 페이지 머릿말입니다.
Foot = """&L" & LFoot & "&R" & RFoot & """"     '// 페이지 꼬릿말입니다.
pLeft = varMargin(0)                            '// 왼쪽여백
pRight = varMargin(1)                           '// 오른쪽여백
Top = varMargin(2)                              '// 윗여백
Bot = varMargin(3)                              '// 아래여백
Head_margin = varMargin(4)                      '// 머릿말여백
Foot_margin = varMargin(5)                      '// 꼬릿말여백
Hdng = 0                                        '// 행/열반복 출력여부 0 = 반복출력안함 1 = 반복출력
Grid = False                                    '// 눈금선출력여부
Notes = False                                   '// 메모출력여부
H_cntr = HCenter                                '// 가운데정렬
V_cntr = VCenter                                '// 중앙정렬
Orient = lngOrient                              '// 문서방향, 1 = 세로 2 = 가로
Paper_size = eSize                              '// 용지크기
Pg_num = 1                                      '// 페이지 시작번호
Pg_order = 1                                    '// 페이지번호 순서, 1 = 위-아래-우 2 = 좌-우-아래
Quality = ""                                    '// 인쇄품질 (dot-per-inch로 입력) (공백 = 자동)
bw_cells = False                                '// 흑백인쇄여부, TRUE = 글자/테두리 검정,배경 흰색 FALSE = 색깔
pScale = 100                                    '// 축소/확대비율 또는 TRUE (Fit to Page)
 
'// 여백을 없음으로 설정할 경우 머릿말/꼬릿말을 삭제하여 인쇄영역과 겹치지 않도록 합니다.
If eMargin = xlNone Then
Head = """"""
Foot = """"""
End If
 
 
'// ExecuteExcel4Macro 명령문을 실행합니다.
pSetup = "PAGE.SETUP(" & Head & ", " & Foot & ", " & pLeft & ", " & pRight & ", " & Top & ", " & Bot & ", "
pSetup = pSetup & Hdng & ", " & Grid & "," & H_cntr & "," & V_cntr & "," & Orient & ","
pSetup = pSetup & Paper_size & "," & pScale & ","
pSetup = pSetup & Pg_num & "," & Pg_order & "," & bw_cells & "," & Quality & ","
pSetup = pSetup & Head_margin & "," & Foot_margin & "," & Notes & ")"
 
 
Application.ExecuteExcel4Macro pSetup
 
'// ExecuteExcel4Macro에서는 '한 페이지에 행/열 맞추기' 기능이 지원되지 않습니다.
'// 따라서 시트의 PageSetup 속성으로 '페이지 행/열 맞추기 기능을 설정합니다.
With WS.PageSetup
If HFit = True Then
.FitToPagesWide = 1
Else
.FitToPagesWide = False
End If
 
If VFit = True Then
.FitToPagesTall = 1
Else
.FitToPagesTall = False
End If
End With
 
'// 인쇄설정 업데이트
Application.PrintCommunication = True
 
End Sub
 
'####################################################
'모듈을 추가한 뒤 복사/붙여넣기 하세요.
'####################################################
 
Sub Rng_To_Pdf(rngSelect As Range, _
                Optional FileName As String = "pdf출력", _
                Optional SavePath As String = "", _
                Optional DocProperty As Boolean = True, _
                Optional PrintArea As Boolean = False, _
                Optional OpenPdf As Boolean = False, _
                Optional AddSequence As Boolean = True)
 
Dim WS As Worksheet
Dim FilePath As String
 
Set WS = rngSelect.Parent
 
If SavePath = "" Then SavePath = GetDesktopPath
 
FilePath = SavePath & FileName & ".pdf"
 
If ValidFileName(FilePath) = False Then MsgBox ("올바른 파일명을 사용하세요"): Exit Sub
 
If AddSequence = True Then
    FilePath = FileSequence(FilePath, 1)
End If
 
rngSelect.ExportAsFixedFormat xlTypePDF, FilePath, xlQualityStandard, DocProperty, PrintArea, , , OpenPdf
 
End Sub