엑셀 시트 나누기 매크로 :: Split_EachWS 명령문

범위 또는 시트를 지정하여 기준에 따라 여러 개의 시트로 나누는 Split_EachWS 명령문의 사용법 및 동작원리를 알아봅니다.

홈페이지 » 엑셀 시트 나누기 매크로 :: Split_EachWS 명령문

엑셀 시트 나누기 매크로 :: Split_EachWS 명령문 사용법 총정리

엑셀 Split_EachWS 명령문 목차 바로가기
요약

엑셀 Split_EachWS 명령문을 실행하면 범위 또는 시트를 기준열에 따라 여러개의 시트로 나눕니다.

명령문 구문
Split_EachWS 범위(시트), [기준열], [머릿글포함], [덮어쓰기], [열자동맞춤] 
사용된 인수 및 변수 알아보기
인수 설명
범위(시트)
[Variant]
여러개의 시트로 나눌 범위 또는 범위가 입력된 시트입니다.
기준열
[Long, 선택인수]
시트를 나눌 기준 열 번호입니다. 기본값은 1 입니다.
머릿글포함
[Boolean, 선택인수]
TRUE일 경우 머릿글을 항상 포함하여 시트를 나눕니다. 범위에 머릿글이 없을 경우 FALSE로 입력합니다. 기본값은 TRUE 입니다.
덮어쓰기
[Boolean, 선택인수]
TRUE 일 경우 나누어진 시트와 동일한 이름의 시트가 있을 시, 기존 시트를 삭제 후 새로운 시트로 덮어쓰기 합니다. 기본값은 FALSE 입니다.
열자동맞춤
[Boolean, 선택인수]
TRUE 일 경우 나누어진 시트의 열 넓이를 자동으로 맞춥니다.
엑셀 시트 나누기 매크로 예제
엑셀 시트 나누기 매크로 사용 예제

예제파일 다운로드

오빠두엑셀의 강의 예제파일은 여러분을 위해 자유롭게 제공하고 있습니다.

  • [엑셀VBA함수] Split_EachWS 명령문 - 예제파일
    예제파일

상세 설명

엑셀 Split_EachWS 명령문은 범위 또는 시트를 지정하여 기준열에 따라 여러개의 시트로 나누는 VBA 매크로 명령문입니다. 만약 각 나누어진 시트를 여러개의 파일로 저장하려면 Save_EachWS 명령문을 사용합니다.

엑셀 시트 나누기 명령문에는 여러개의 보조 함수가 사용되었습니다. 각 보조 함수에 대한 자세한 설명은 아래 관련 링크를 참고하세요.

실전 사용 예제
  1. "직원목록" 시트에 입력된 범위를 부서명 기준으로 시트 나누기
    '직원목록시트 : 부서명 | 이름 | 나이 | 직급
    Sub Test()
    Dim WS As Worksheet
     
    Set WS = ThisWorkbook.Worksheets("직원목록")
    'Set Rng = WS.Range("A1").CurrentRegion
     
    Split_EachWS WS
     
    End Sub
  2. "직원목록" 시트의 A1:E100 범위를 직급 기준으로 시트 나누기
    '직원목록시트 : 부서명 | 이름 | 나이 | 직급
    Sub Test2()
     
    Dim WS As Worksheet
    Dim Rng As Range
     
    Set WS = ThisWorkbook.Worksheets("직원목록")
    Set Rng = WS.Range("A1:E100")
     
    Split_EachWS Rng, 4
     
    End Sub

엑셀 시트 나누기 매크로, Split_EachWS 명령문 동작원리

Split_EachWS 명령문 전체 코드
Sub Split_EachWS(Target, Optional UniqueCol As Long = 1, _
                Optional isHeader As Boolean = True, _
                Optional isOverWrite As Boolean = False, _
                Optional blnAutofit As Boolean = True)
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
 
'■ Split_EachWS 함수
'■ 시트에 입력된 표를 기준에 따라 여러개의 시트로 나눕니다.
'■ 사용방법
'Split_EachWS ThisWorkbook.Worksheets("시트명"), 1
'■ 인수 설명
'_____________Target            : 여러개의 시트로 나눌 범위 또는 범위가 입력된 시트입니다.
'_____________UniqueCol         : 여러개의 시트로 나눌 기준 열 번호입니다.
'_____________isHeader          : True일 경우 나누어진 시트에 머릿글을 항상 포함합니다.
'_____________isOverWrite       : True일 경우 기존에 존재하던 시트를 지우고 덮어쓰기 합니다.
'_____________blnAutofit        : True일 경우 나누어진 시트의 열 넓이를 자동으로 맞춥니다.
'■ 사용된 보조 명령문
'Get_UniqueDB 함수
'Filtered_DB 함수
'ArrayToRng 함수
'###############################################################
 
Dim DB As Variant: Dim uDB As Variant: Dim fDB As Variant
 
Dim endRow As Long: Dim endCol As Long
Dim cRow As Long: Dim cCol As Long
 
Dim WB As Workbook: Dim v As Variant:
Dim WS As Worksheet: Dim tWS As Worksheet: Dim nWS As Worksheet
 
Dim blnPass As Boolean: blnPass = True
 
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
 
If TypeName(Target) = "Worksheet" Then
    Set WS = Target
    With WS
        cRow = .UsedRange.Row
        cCol = .UsedRange.Column
        endRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
        endCol = .UsedRange.Columns.Count + .UsedRange.Column - 1
        If isHeader = True Then
            DB = .Range(.Cells(cRow + 1, cCol), .Cells(endRow, endCol))
        Else
            DB = .Range(.Cells(cRow, cCol), .Cells(endRow, endCol))
        End If
    End With
Else
    With Target
        Set WS = .Parent
        cRow = .Row
        cCol = .Column
        endRow = .Rows.Count + .Row - 1
        endCol = .Columns.Count + .Column - 1
        If isHeader = True Then
            DB = WS.Range(WS.Cells(cRow + 1, cCol), WS.Cells(endRow, endCol))
        Else
            DB = Target
        End If
    End With
End If
 
Set WB = WS.Parent
uDB = Get_UniqueDB(DB, UniqueCol, True)
 
If isOverWrite = False Then
    For Each v In uDB
        For Each tWS In WB.Worksheets
            If tWS.Name = v Then: MsgBox "중복 시트가 존재합니다." & vbNewLine & "[시트명 :" & tWS.Name & " ]": Exit Sub
        Next
    Next
End If
 
For Each v In uDB
    Set nWS = WB.Worksheets.Add(after:=Worksheets(WB.Worksheets.Count))
    On Error GoTo DeleteSheet
AfterDelete:
    nWS.Name = v
    fDB = Filtered_DB(DB, v, UniqueCol, True)
    If isHeader = True Then
        With WS
            .Range(.Cells(cRow, cCol), .Cells(cRow, endCol)).Copy nWS.Range(nWS.Cells(1, 1), nWS.Cells(1, endCol - cCol + 1))
            ArrayToRng nWS.Range("A2"), fDB
        End With
    Else
       ArrayToRng nWS.Range("A1"), fDB
    End If
    If blnAutofit = True Then nWS.UsedRange.EntireColumn.AutoFit
Next
 
WS.Activate
 
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
 
Exit Sub
 
DeleteSheet:
Application.DisplayAlerts = False
WB.Worksheets(v).Delete
Application.DisplayAlerts = True
Resume AfterDelete
 
End Sub
 
Function Get_UniqueDB(DB, Optional UniqueCol As Long, Optional UniqueOnly As Boolean = True) As Variant
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
 
'■ Get_UniqueDB 함수
'■ 배열의 특정열 또는 전체 열을 참조하여 고유값을 반환합니다.
'■ 사용방법
'DB = GetUnique_DB(DB)
'■ 인수 설명
'_____________DB                  : 고유값을 추출할 배열입니다.
'_____________UniqueCol      : 고유값을 참조할 열 번호입니다. 열 번호가 없을 경우 모든 열을 참조하여 고유값을 판단합니다.
'_____________UniqueOnly    :  True 일 경우 결과값으로 해당 열번호만 반환합니다. False 일 경우 결과값으로 모든 열을 반환합니다.
'###############################################################
 
Dim Dict As Object
Dim i As Long: Dim j As Long: Dim a As Long: a = 1
Dim s As String
Dim v As Variant: Dim vArr As Variant
Dim ArrD As Integer
 
Set Dict = CreateObject("scripting.dictionary")
 
On Error Resume Next
 
Do
    i = i + 1
    j = UBound(DB, i)
Loop Until Err.Number <> 0
Err.Clear
ArrD = i - 1
 
On Error GoTo 0
 
If ArrD > 1 Then
    If UniqueCol = 0 Then
        For i = LBound(DB) To UBound(DB)
            For j = LBound(DB, 2) To UBound(DB, 2)
                s = s & DB(i, j) & "|"
            Next
            If Not Dict.Exists(s) Then Dict.Add s, i
        Next
    Else
        For i = LBound(DB) To UBound(DB)
            s = DB(i, UniqueCol)
            If Not Dict.Exists(s) Then Dict.Add s, i
        Next
    End If
    If UniqueOnly = False Or UniqueCol = 0 Then
        ReDim vArr(1 To Dict.Count, LBound(DB, 2) To UBound(DB, 2))
    Else
        ReDim vArr(1 To Dict.Count)
    End If
GoTo Parse2D
Else
    For i = LBound(DB) To UBound(DB)
        s = Dict(i)
        If Not Dict.Exists(s) Then Dict.Add s, i
    Next
    ReDim vArr(1 To Dict.Count)
GoTo Parse1D
End If
 
Parse2D:
For Each v In Dict.Keys
    i = Dict(v)
    If UniqueOnly = False Or UniqueCol = 0 Then
        For j = LBound(vArr, 2) To UBound(vArr, 2)
            vArr(a, j) = DB(i, j)
        Next
    Else
        vArr(a) = DB(i, UniqueCol)
    End If
    a = a + 1
Next
GoTo Final
 
Parse1D:
For Each v In Dict.Keys
    i = Dict(v)
    vArr(a) = DB(i)
    a = a + 1
Next
GoTo Final
 
Final:
Get_UniqueDB = vArr
 
End Function
 
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
 
'■ Filtered_DB 함수
'■ 서로 다른 두 시트를 연결합니다. FromWS의 첫번째 필드는 반드시 고유값(ID)이 입력되어야 합니다.
'■ 사용방법
'Array = Filtered_DB(Get_DB(Sheet1),">=200")
'■ 인수 설명
'_____________DB                  : 데이터를 필터링 할 원본 DB 입니다.
'_____________Value             : 필터링 할 조건입니다.
'_____________FilterCol         : [선택인수] 필터링 할 검색 열입니다. 빈칸일 경우 전체 열을 대상으로 필터링합니다.
'_____________ExactMatch   : [선택인수] 정확히 일치 여부입니다. 기본값은 False(=유사일치) 입니다.
'###############################################################
 
Function Filtered_DB(DB, Value, Optional FilterCol, Optional ExactMatch As Boolean = False) As Variant
 
Dim cRow As Long
Dim cCol As Long
Dim vArr As Variant: Dim s As String: Dim filterArr As Variant:  Dim Cols As Variant: Dim Col As Variant: Dim Colcnt As Long
Dim isDateVal As Boolean
Dim vReturn As Variant: Dim vResult As Variant
Dim Dict As Object: Dim dictKey As Variant
Dim i As Long: Dim j As Long
Dim Operator As String
 
Set Dict = CreateObject("Scripting.Dictionary")
 
If Value <> "" Then
    cRow = UBound(DB, 1)
    cCol = UBound(DB, 2)
    ReDim vArr(1 To cRow)
    For i = 1 To cRow
        s = ""
        For j = 1 To cCol
            s = s & DB(i, j) & "|^"
        Next
        vArr(i) = s
    Next
 
    If IsMissing(FilterCol) Then
        filterArr = vArr
    Else
        Cols = Split(FilterCol, ",")
        ReDim filterArr(1 To cRow)
        For i = 1 To cRow
            s = ""
            For Each Col In Cols
                s = s & DB(i, Trim(Col)) & "|^"
            Next
            filterArr(i) = s
        Next
    End If
 
    If Left(Value, 2) = ">=" Or Left(Value, 2) = "<=" Or Left(Value, 2) = "=>" Or Left(Value, 2) = "=<" Then
        Operator = Left(Value, 2)
        If IsDate(Right(Value, Len(Value) - 2)) Then isDateVal = True
    ElseIf Left(Value, 1) = ">" Or Left(Value, 1) = "<" Then
        Operator = Left(Value, 1)
        If IsDate(Right(Value, Len(Value) - 1)) Then isDateVal = True
    Else: End If
 
    If Operator <> "" Then
        If isDateVal = False Then
            Select Case Operator
                Case ">"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) > CDbl(Right(Value, Len(Value) - 1)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                Case "<"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) < CDbl(Right(Value, Len(Value) - 1)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                Case ">=", "=>"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) >= CDbl(Right(Value, Len(Value) - 2)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                 Case "<=", "=<"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) <= CDbl(Right(Value, Len(Value) - 2)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
            End Select
        Else
            Select Case Operator
                Case ">"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) > CDate(Right(Value, Len(Value) - 1)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                Case "<"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) < CDate(Right(Value, Len(Value) - 1)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                Case ">=", "=>"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) >= CDate(Right(Value, Len(Value) - 2)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                 Case "<=", "=<"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) <= CDate(Right(Value, Len(Value) - 2)) Then: vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
            End Select
        End If
    Else
        If ExactMatch = False Then
            For i = 1 To cRow
                If filterArr(i) Like "*" & Value & "*" Then
                    vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                    vReturn = Split(vArr(i), "|^")
                    Dict.Add i, vReturn
                End If
            Next
        Else
            For i = 1 To cRow
                If filterArr(i) Like Value & "|^" Then
                    vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                    vReturn = Split(vArr(i), "|^")
                    Dict.Add i, vReturn
                End If
            Next
        End If
    End If
 
    If Dict.Count > 0 Then
        ReDim vResult(1 To Dict.Count, 1 To cCol)
        i = 1
        For Each dictKey In Dict.Keys
            For j = 1 To cCol
                vResult(i, j) = Dict(dictKey)(j - 1)
            Next
            i = i + 1
        Next
    End If
 
    Filtered_DB = vResult
Else
    Filtered_DB = DB
End If
 
End Function
 
Sub ArrayToRng(startRng As Range, Arr As Variant, Optional ColumnNo As String = "")
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ArrayToRng 함수
'▶ 배열을 범위 위로 반환합니다.
'▶ 인수 설명
'_____________startRng      : 배열을 반환할 기준 범위(셀) 입니다.
'_____________Arr               : 반환할 배열입니다.
'_____________ColumnNo   : [선택인수] 배열의 특정 열을 선택하여 범위로 반환합니다. 여러개 열을 반환할 경우 열 번호를 쉼표로 구분하여 입력합니다.
'                                               값으로 공란을 입력하면 열을 건너뜁니다.
'▶ 사용 예제
'Dim v As Variant
'ReDim v(0 to 1)
''v(0) = "a" : v(1) = "b"
'ArrayToRng Sheet1.Range("A1"), v
'▶ 사용된 보조 명령문
'Extract_Column 함수
'##############################################################
 
On Error GoTo SingleDimension:
 
Dim Cols As Variant: Dim Col As Variant
Dim X As Long: X = 1
If ColumnNo = "" Then
    startRng.Cells(1, 1).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) = Arr
Else
    Cols = Split(ColumnNo, ",")
    For Each Col In Cols
        If Trim(Col) <> "" Then
            startRng.Cells(1, X).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1) = Extract_Column(Arr, CLng(Trim(Col)))
        End If
        X = X + 1
    Next
End If
Exit Sub
 
SingleDimension:
Dim tempArr As Variant: Dim i As Long
ReDim tempArr(LBound(Arr, 1) To UBound(Arr, 1), 1 To 1)
For i = LBound(Arr, 1) To UBound(Arr, 1)
    tempArr(i, 1) = Arr(i)
Next
startRng.Cells(1, 1).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, 1) = tempArr
 
End Sub
 
'########################
' 배열에서 특정 열 데이터만 추출합니다.
' Array = Extract_Column(Array, 1)
'########################
 
Function Extract_Column(DB As Variant, Col As Long) As Variant
 
Dim i As Long
Dim vArr As Variant
 
ReDim vArr(LBound(DB) To UBound(DB), 1 To 1)
For i = LBound(DB) To UBound(DB)
        vArr(i, 1) = DB(i, Col)
Next
 
Extract_Column = vArr
 
End Function
명령문 동작원리 단계별 알아보기
  1. 명령문에 사용된 변수를 선언하고 변수에 값을 입력합니다.
    Dim DB As Variant: Dim uDB As Variant: Dim fDB As Variant
     
    Dim endRow As Long: Dim endCol As Long
    Dim cRow As Long: Dim cCol As Long
     
    Dim WB As Workbook: Dim v As Variant:
    Dim WS As Worksheet: Dim tWS As Worksheet: Dim nWS As Worksheet
     
    Dim blnPass As Boolean: blnPass = True
  2. 보다 빠르게 실행하기 위해 화면 업데이트 및 이벤트, 함수 계산을 잠시 중단합니다.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    '...
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
  3. Split_EachWS 의 첫번째 인수가 범위인 경우와 시트인 경우를 구분하여 여러개의 시트로 나눌 대상 범위를 지정합니다.
    If TypeName(Target) = "WorkSheet" Then
        Set WS = Target
        With WS
            cRow = .UsedRange.Row
            cCol = .UsedRange.Column
            endRow = .UsedRange.Rows.Count + .UsedRange.Row - 1
            endCol = .UsedRange.Columns.Count + .UsedRange.Column - 1
            If isHeader = True Then
                DB = .Range(.Cells(cRow + 1, cCol), .Cells(endRow, endCol))
            Else
                DB = .Range(.Cells(cRow, cCol), .Cells(endRow, endCol))
            End If
        End With
    Else
        With Target
            Set WS = .Parent
            cRow = .Row
            cCol = .Column
            endRow = .Rows.Count + .Row - 1
            endCol = .Columns.Count + .Column - 1
            If isHeader = True Then
                DB = WS.Range(WS.Cells(cRow + 1, cCol), WS.Cells(endRow, endCol))
            Else
                DB = Target
            End If
        End With
    End If
     
    Set WB = WS.Parent
  4. 범위의 기준 열에서 고유값을 추출합니다.
    uDB = Get_UniqueDB(DB, UniqueCol, True)
  5. 덮어쓰기여부가 FALSE 일 경우 기존 동일한 이름의 시트가 있는지 확인합니다.
    If isOverWrite = False Then
        For Each v In uDB
            For Each tWS In WB.Worksheets
                If tWS.Name = v Then: MsgBox "중복 시트가 존재합니다." & vbNewLine & "[시트명 :" & tWS.Name & " ]": Exit Sub
            Next
        Next
    End If
  6. 각 기준에 따라 범위를 필터링 하여 여러개의 시트로 나눕니다.
    For Each v In uDB
        Set nWS = WB.Worksheets.Add(after:=Worksheets(WB.Worksheets.Count))
        On Error GoTo DeleteSheet
    AfterDelete:
        nWS.Name = v
        fDB = Filtered_DB(DB, v, UniqueCol)
        If isHeader = True Then
            With WS
                .Range(.Cells(cRow, cCol), .Cells(cRow, endCol)).Copy nWS.Range(nWS.Cells(1, 1), nWS.Cells(1, endCol - cCol + 1))
                ArrayToRng nWS.Range("A2"), fDB
            End With
        Else
           ArrayToRng nWS.Range("A1"), fDB
        End If
        If blnAutofit = True Then nWS.UsedRange.EntireColumn.AutoFit
    Next
     
    WS.Activate
     
    Exit Sub
     
    DeleteSheet:
    Application.DisplayAlerts = False
    WB.Worksheets(v).Delete
    Application.DisplayAlerts = True
    Resume AfterDelete
0 0 투표
게시글평점
guest
0 댓글
Inline Feedbacks
모든 댓글 보기
0
여러분의 생각을 댓글로 남겨주세요.x