[엑셀 매크로/VBA] Unpivot, 크로스탭 데이터를 리스트/목록으로 바꿔주기

매크로를 쓰는 자세한 방법은 문서 맨 아래 링크를 참고하세요 :)

 

세로 열로 구성된 데이터를 행으로 내리는 매크로입니다.

(제가 가장 자주 쓰고, 가장 필요로 하는 unpivot 매크로입니다.)

 - 엑셀 2016부터는 파워쿼리라는 기능을 이용하면서부터, 매크로 없이도 구현이 가능하게 되었습니다만,

 - 파워쿼리 자체에 대한 설치/활용에 대한 거부감이 있는 분들에게는 아직 매크로가 더 나은 대안이 될 수있죠.

 - 필요할때만 한번, 열어서 활용하시면 좋습니다.

 

이렇게 가로로 나열되어 있는 데이터를

요렇게! 세로로 묶어서 보여줍니다. 피벗테이블을 구성하거나 데이터를 분석할 때 가장 필수적인 부분이라고 보시면 됩니다.

=========아래를 붙여넣기 하세요==========

Sub Unpivoting()
    On Error Resume Next
    
    Selection.CurrentRegion.Select
    Set TotRng = Application.InputBox("범위 선택", "데이터 범위 전체를 선택해주세요 (머리말포함).", Selection.Address, Type:=8)
    SheetName1 = ActiveSheet.Name
    Set WorkRng = Application.InputBox("범위 선택", "Unpivot을 할 필드만 선택해주세요.", Selection.Address, Type:=8)
    Set WS = Sheets.Add
    SheetName2 = ActiveSheet.Name
    Set OutpRng = Sheets(SheetName2).Range("A1")
    Worksheets(SheetName1).Activate
    
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    
    'Unpivot은 항상 오른쪽 끝에서 한다는 가정
    TotRow = TotRng.Rows.Count
    TotCol = TotRng.Columns.Count
    NonSelRow = WorkRng.Rows.Count
    SelCol = WorkRng.Columns.Count
    SelRow = TotRow - NonSelRow
    NonSelCol = TotCol - SelCol
    Set NSRng = TotRng.Resize(TotRow, NonSelCol)
    Set SRng = WorkRng.Resize(SelRow).Offset(NonSelRow, 0)
    SRng.Select
    
    'Header Paste
    NSRng.Rows(1).Copy
    OutpRng.PasteSpecial Paste:=xlPasteValues
    For i = 0 To NonSelRow - 1
        OutpRng.Offset(0, NonSelCol + i).Value = "Header_" & i
    Next
    OutpRng.Offset(0, NonSelCol + NonSelRow).Value = "Value"
    Set PasteCell = OutpRng.Offset(1, 0)
    
    For i = 1 To SelCol
        F = SRng.Columns(i).SpecialCells(xlCellTypeFormulas).Count
        C = SRng.Columns(i).SpecialCells(xlCellTypeConstants).Count
        
        If F <> Empty Then '상수 복사
            For j = 0 To NonSelCol - 1
                SRng.Columns(i).SpecialCells(xlCellTypeFormulas).Offset(0, -i - j).Copy 'Formula 적용 안됨
                PasteCell.Offset(0, NonSelCol - j - 1).PasteSpecial Paste:=xlPasteValues
            Next
            
            WorkRng.Columns(i).Copy
            PasteCell.Resize(F).Offset(0, NonSelCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            SRng.Columns(i).SpecialCells(xlCellTypeFormulas).Copy
            PasteCell.Offset(0, NonSelCol + NonSelRow).PasteSpecial Paste:=xlPasteValues
            
            Set PasteCell = PasteCell.Offset(F, 0)
            F = Empty 'error handler
        End If
        
        If C <> Empty Then '상수 복사
            For j = 0 To NonSelCol - 1
                SRng.Columns(i).SpecialCells(xlCellTypeConstants).Offset(0, -i - j).Copy 'Formula 적용 안됨
                PasteCell.Offset(0, NonSelCol - j - 1).PasteSpecial Paste:=xlPasteValues
            Next
            
            WorkRng.Columns(i).Copy
            PasteCell.Resize(C).Offset(0, NonSelCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            SRng.Columns(i).SpecialCells(xlCellTypeConstants).Copy
            PasteCell.Offset(0, NonSelCol + NonSelRow).PasteSpecial Paste:=xlPasteValues
            
            Set PasteCell = PasteCell.Offset(C, 0)
            C = Empty 'error handler
        End If
    Next
    MsgBox "Unpivot Completed"
End Sub

==================================

 

구체적인 사용법

1. 매크로를 실행해서, 원하는 표 전체를 선택합니다.

데이터 표를 전체로 선택한다.

 

2. unpivot할 필드, 그러니까 전부 세로로 떨어트리려는 필드를 선택합니다.

 - 머릿말만 선택해도 됩니다. 여기선 B1-E1을 선택하면 되겠습니다 (숫자1-숫자4)

아래로 떨굴 필드만 선택하면 된다.

 

3. 새로운 시트가 생성되면서, 아래의 결과를 만들어줍니다.

새로운 시트에 결과를 만들어준다.

 

https://mwoe.tistory.com/71

[매크로/VBA] 매크로 코드를 실행하는 법