이 페이지에서

실무 위키›VBA 코드›CreateTOC

CreateTOC

Sub

통합문서의 시트를 기준에 따라 분류·정렬해 목차 시트를 생성하는 VBA 명령문입니다.

예제파일 다운로드

구문 CreateTOC [분류기준], [정렬방향], [돌아가기링크생성], [링크위치]

인수구분 형식 설명

SortByLength 선택 Variant

시트를 분류할 기준입니다. 숫자 또는 기호를 입력하며, 기본값은 빈 문자열입니다.

숫자를 입력하면 시트명 왼쪽부터 그 자리수까지를, 기호를 입력하면 기호 바로 앞까지의 값을 기준으로 시트를 분류합니다.

SortOrder 선택 Long

시트 정렬 방향입니다. 기본값은 0(정렬 안 함)입니다.

1은 오름차순, -1은 내림차순, 0은 정렬하지 않습니다.

returnBtn 선택 Boolean

[목차로 돌아가기] 링크 생성 여부입니다. 기본값은 FALSE 입니다.

BtnCell 선택 String

목차로 돌아가기 링크를 생성할 셀 주소입니다. 기본값은 "A1" 입니다.

마스터 코드

복사한 코드는 VBA 편집기(Alt + F11) 새 모듈에 붙여넣어 사용하세요

'###############################################################
'오빠두엑셀 VBA 사용자 지정함수 (https://www.oppadu.com)
'■ CreateTOC 명령문
'■ 통합문서의 각 시트를 기준에따라 정렬 및 분류하여 목차를 생성합니다.
'■ 인수 설명
'_____________SortByLength      : 시트를 분류할 기준입니다. 숫자 또는 기호를 받아옵니다.
'_____________SortOrder         : 시트 정렬 방향입니다. (1: 오름차순, -1: 내림차순, 0: 정렬안함)
'_____________resultBtn         : 목차로 돌아가기 링크 생성 여부입니다.
'_____________BtnCell           : 목차로 돌아가기 링크를 생성할 셀 주소입니다.
'■ 사용된 기타 사용자지정함수
'_____________SortArray 함수
'■ 그외 참고사항
'###############################################################

Sub CreateTOC(Optional SortByLength As Variant = "", Optional SortOrder As Long = 0, Optional returnBtn As Boolean = False, Optional BtnCell As String = "A1")

Dim WB As Workbook: Dim WS As Worksheet: Dim tocWS As Worksheet
Dim vaArr As Variant
Dim i As Long: Dim x As Long: Dim j As Long: Dim jj As Long: x = 0: j = 0: jj = 1
Dim groupLen As Variant: Dim prefix As String: groupLen = 0

Application.ScreenUpdating = False

Set WB = ActiveWorkbook
Set tocWS = WB.Worksheets.Add(Before:=WB.Worksheets(1))

'<--! 임시 배열 생성 -->;
ReDim vaArr(0 To WB.Worksheets.Count - 2)
For i = 2 To WB.Worksheets.Count
    Set WS = WB.Worksheets(i)
    '// ======= 2020.01.09 숨김시트 목록에서 제외 ========
    If WS.Visible = xlSheetVisible Then vaArr(j) = WB.Worksheets(i).Name: j = j + 1
Next

'// ======= 2020.01.09 배열 Redim 및 변수 초기화 ========
ReDim Preserve vaArr(0 To j - 1)
j = 0

'<--! 임시 배열 정렬 -->;
If SortOrder = 1 Then vaArr = SortArray(vaArr, xlAscending)
If SortOrder = -1 Then vaArr = SortArray(vaArr, xlDescending)

tocWS.Activate
ActiveWindow.DisplayGridlines = False

'<--! 목차시트 꾸미기 -->;
With tocWS
    On Error GoTo shtexist
    .Name = "목차"
resume_1:
    .Tab.Color = RGB(47, 47, 47)
    .Range("A:B").EntireColumn.ColumnWidth = 4
    .Range("4:500").EntireRow.RowHeight = 20
    .Range("2:2").Interior.Color = RGB(47, 47, 47)
    .Range("1:1").EntireRow.RowHeight = 11
    
    With .Range("B2")
        .Value = "목차"
        .Font.Bold = True
        .Font.Size = 18
        .Font.Color = RGB(255, 255, 255)
    End With
    
    .Range("B4").Value = "#"
    .Range("C4").Value = "시트명"
    With .Range("B4").EntireRow
        .Font.Bold = True
        .Font.Color = RGB(255, 255, 255)
        .Interior.Color = RGB(89, 89, 89)
    End With
    
'<--! 임시 배열의 값을 하나씩 돌아가며 목차 생성 -->;
    For i = LBound(vaArr) To UBound(vaArr)
        
        If IsNumeric(SortByLength) = True Then
            groupLen = SortByLength
        Else
            If InStr(1, vaArr(i), SortByLength) > 0 Then groupLen = InStr(1, vaArr(i), SortByLength) - 1
        End If
        On Error Resume Next
        If Left(vaArr(i - 1), groupLen) <> Left(vaArr(i), groupLen) Then
           
            If (i = LBound(vaArr) And SortOrder = 0) Then
                j = j + 1: jj = 1
            Else
                j = j + 1: jj = 1
                .Cells(x + 5, 2).Value = j
                .Cells(x + 5, 3).Value = Left(vaArr(i), groupLen)
                If .Cells(x + 5, 3).Value = "" Then .Cells(x + 5, 3).Value = "기타항목"
                .Cells(x + 5, 2).NumberFormat = "0*."
                .Cells(x + 5, 1).EntireRow.Font.Bold = True
                .Cells(x + 5, 1).EntireRow.Interior.Color = RGB(245, 245, 245)
                x = x + 1
            End If
            On Error GoTo 0
        Else
            jj = jj + 1
        End If
        
        If blnSort = True Then prefix = "'" & j & "-"
        
        .Cells(x + 5, 2).Value = prefix & jj
        .Cells(x + 5, 2).NumberFormat = "_~@"
        .Hyperlinks.Add anchor:=.Cells(x + 5, 3), Address:="", SubAddress:="'" & CStr(vaArr(i)) & "'!A1", TextToDisplay:="'" & vaArr(i) '// 2020.02.11 수정 : 숫자형식 시트명 텍스트형식으로 변경
        .Cells(x + 5, 3).InsertIndent 1
        
        x = x + 1
    Next
    
    .Range("C:C").EntireColumn.AutoFit
      
End With

'<--! 각 시트에 '목차로 돌아가기' 링크 생성 -->;
If returnBtn = True Then
    For i = 2 To WB.Worksheets.Count
        WB.Worksheets(i).Hyperlinks.Add anchor:=WB.Worksheets(i).Range(BtnCell), Address:="", SubAddress:=tocWS.Name & "!A1", TextToDisplay:="목차로 돌아가기"
        WB.Worksheets(i).Range(BtnCell).Font.Bold = True
    Next
End If


Application.ScreenUpdating = True

Exit Sub

shtexist:
    tocWS.Name = "목차" & Format(Now, "yyyymmddhhmmss")
    On Error GoTo 0
    Resume resume_1

End Sub

Module1 · CreateTOC

'###############################################################

'오빠두엑셀 VBA 사용자 지정함수 (https://www.oppadu.com)

'■ CreateTOC 명령문

'■ 통합문서의 각 시트를 기준에따라 정렬 및 분류하여 목차를 생성합니다.

'■ 인수 설명

'_____________SortByLength : 시트를 분류할 기준입니다. 숫자 또는 기호를 받아옵니다.

'_____________SortOrder : 시트 정렬 방향입니다. (1: 오름차순, -1: 내림차순, 0: 정렬안함)

'_____________resultBtn : 목차로 돌아가기 링크 생성 여부입니다.

'_____________BtnCell : 목차로 돌아가기 링크를 생성할 셀 주소입니다.

'■ 사용된 기타 사용자지정함수

'_____________SortArray 함수

'■ 그외 참고사항

'###############################################################

Sub CreateTOC(Optional SortByLength As Variant = "", Optional SortOrder As Long = 0, Optional returnBtn As Boolean = False, Optional BtnCell As String = "A1")

Dim WB As Workbook: Dim WS As Worksheet: Dim tocWS As Worksheet

Dim vaArr As Variant

Dim i As Long: Dim x As Long: Dim j As Long: Dim jj As Long: x = 0: j = 0: jj = 1

Dim groupLen As Variant: Dim prefix As String: groupLen = 0

Application.ScreenUpdating = False

Set WB = ActiveWorkbook

Set tocWS = WB.Worksheets.Add(Before:=WB.Worksheets(1))

'<--! 임시 배열 생성 -->;

ReDim vaArr(0 To WB.Worksheets.Count - 2)

For i = 2 To WB.Worksheets.Count

Set WS = WB.Worksheets(i)

'// ======= 2020.01.09 숨김시트 목록에서 제외 ========

If WS.Visible = xlSheetVisible Then vaArr(j) = WB.Worksheets(i).Name: j = j + 1

'// ======= 2020.01.09 배열 Redim 및 변수 초기화 ========

ReDim Preserve vaArr(0 To j - 1)

j = 0

'<--! 임시 배열 정렬 -->;

If SortOrder = 1 Then vaArr = SortArray(vaArr, xlAscending)

If SortOrder = -1 Then vaArr = SortArray(vaArr, xlDescending)

tocWS.Activate

ActiveWindow.DisplayGridlines = False

'<--! 목차시트 꾸미기 -->;

With tocWS

On Error GoTo shtexist

.Name = "목차"

resume_1:

.Tab.Color = RGB(47, 47, 47)

.Range("A:B").EntireColumn.ColumnWidth = 4

.Range("4:500").EntireRow.RowHeight = 20

.Range("2:2").Interior.Color = RGB(47, 47, 47)

.Range("1:1").EntireRow.RowHeight = 11

With .Range("B2")

.Value = "목차"

.Font.Bold = True

.Font.Size = 18

.Font.Color = RGB(255, 255, 255)

End With

.Range("B4").Value = "#"

.Range("C4").Value = "시트명"

With .Range("B4").EntireRow

.Font.Bold = True

.Font.Color = RGB(255, 255, 255)

.Interior.Color = RGB(89, 89, 89)

End With

'<--! 임시 배열의 값을 하나씩 돌아가며 목차 생성 -->;

For i = LBound(vaArr) To UBound(vaArr)

If IsNumeric(SortByLength) = True Then

groupLen = SortByLength

Else

If InStr(1, vaArr(i), SortByLength) > 0 Then groupLen = InStr(1, vaArr(i), SortByLength) - 1

End If

On Error Resume Next

If Left(vaArr(i - 1), groupLen) <> Left(vaArr(i), groupLen) Then

If (i = LBound(vaArr) And SortOrder = 0) Then

j = j + 1: jj = 1

Else

j = j + 1: jj = 1

.Cells(x + 5, 2).Value = j

.Cells(x + 5, 3).Value = Left(vaArr(i), groupLen)

If .Cells(x + 5, 3).Value = "" Then .Cells(x + 5, 3).Value = "기타항목"

.Cells(x + 5, 2).NumberFormat = "0*."

.Cells(x + 5, 1).EntireRow.Font.Bold = True

.Cells(x + 5, 1).EntireRow.Interior.Color = RGB(245, 245, 245)

x = x + 1

End If

On Error GoTo 0

Else

jj = jj + 1

End If

If blnSort = True Then prefix = "'" & j & "-"

.Cells(x + 5, 2).Value = prefix & jj

.Cells(x + 5, 2).NumberFormat = "_~@"

.Hyperlinks.Add anchor:=.Cells(x + 5, 3), Address:="", SubAddress:="'" & CStr(vaArr(i)) & "'!A1", TextToDisplay:="'" & vaArr(i) '// 2020.02.11 수정 : 숫자형식 시트명 텍스트형식으로 변경

.Cells(x + 5, 3).InsertIndent 1

x = x + 1

.Range("C:C").EntireColumn.AutoFit

End With

'<--! 각 시트에 '목차로 돌아가기' 링크 생성 -->;

If returnBtn = True Then

For i = 2 To WB.Worksheets.Count

WB.Worksheets(i).Hyperlinks.Add anchor:=WB.Worksheets(i).Range(BtnCell), Address:="", SubAddress:=tocWS.Name & "!A1", TextToDisplay:="목차로 돌아가기"

WB.Worksheets(i).Range(BtnCell).Font.Bold = True

End If

Application.ScreenUpdating = True

Exit Sub

shtexist:

tocWS.Name = "목차" & Format(Now, "yyyymmddhhmmss")

On Error GoTo 0

Resume resume_1

End Sub

활용 예제

시트 순서 그대로 · 오름차순 정렬해 목차 만들기

'// 통합문서 시트 순서 그대로 목차를 생성합니다.

CreateTOC

'// 시트를 오름차순으로 정렬한 뒤 목차를 생성합니다.

CreateTOC SortOrder:=1

기호로 분류하고 목차로 돌아가기 링크 넣기

'// 시트를 오름차순으로 정렬한 뒤 "-" 기호를 기준으로 분류합니다.

CreateTOC "-", 1

'// 각 시트 B1 셀에 목차로 돌아가기 링크를 생성합니다.

CreateTOC "-", 1, True, "B1"

안내사항

시트 정렬 기능을 사용하려면 SortArray 함수를 같은 모듈에 함께 붙여넣어야 합니다.

목차 시트는 통합문서 맨 앞에 새로 추가되며, 숨겨진 시트는 목차 목록에서 제외됩니다.

5 (3개 평가)

솔 2020.01.22 16:20

열심히 공부하겠습니다.
질문 : 만약 시트명이 "002" 등으로 적용되었을 경우 이를 일반 서식으로 인식하여 숫자 2로 표시되는데 이를 개선할 수는 없나요?

오빠두엑셀 작성자 2020.02.11 18:29

안녕하세요~^^*
명령문의 아래 부분을 찾아서

.Hyperlinks.Add anchor:=.Cells(x + 5, 3), Address:="", SubAddress:="'" & CStr(vaArr(i)) & "'!A1", TextToDisplay:=vaArr(i)

아래처럼 변경해보시겠어요?

.Hyperlinks.Add anchor:=.Cells(x + 5, 3), Address:="", SubAddress:="'" & CStr(vaArr(i)) & "'!A1", TextToDisplay:="'" & vaArr(i)

제 답변이 도움이 되셨으면 좋겠습니다 ^^
좋은 의견 감사드립니다.

림수 2020.04.10 20:16

정말 잘써먹고? 있습니다. 목차를 만드니 데이터 취합하기도 쉽네요

강민준🤗 2024.08.11 12:06

좋은 자료 감사합니다.🙇‍♂️

CreateTOC

마스터 코드

활용 예제

안내사항

바로가기

커뮤니티

문의

[공지] 오빠두에듀 프리랜서 보조 강사 모집

[직원 채용] 오빠두엑셀이 정규직 동료를 모십니다

두드림 무료 챌린지, 새단장 프로모션