엑셀VBA 가로로 정리 된 데이터 세로로 변형하기

 

Sub Test()

    Dim m As Workbook
    Dim ms As Worksheet

    Set m = Workbooks(ThisWorkbook.Name)

    For Each ms In m.Sheets

        If ms.Name = "청라" Then
            Set ms = ms

            Dim i As Integer: Dim j As Integer
            Dim START_ROW As Integer: Dim START_COL As Integer
            Dim outv As Variant

            '// (1 To 7) : Row : tctype
            ReDim outv(1 To 7, 1 To 1)

            START_ROW = 13
            START_COL = 4

            Dim r As Integer: r = 1
            '// 우측으로 이름 반복
            For i = 4 To ms.Cells(START_ROW, Columns.Count).End(1).Column

                '// 이름의 아래로 값 담기
                For j = START_ROW + 1 To ms.Cells(Rows.Count, 2).End(3).Row
                    ReDim Preserve outv(1 To 7, 1 To r)

                    outv(1, r) = ms.Cells(j, 2) '// tctype
                    outv(2, r) = ms.Cells(j, 3) '// test item
                    outv(3, r) = ms.Cells(START_ROW, i) '// name
                    outv(4, r) = ms.Cells(j, i)
                    outv(5, r) = ms.Name
                    r = r + 1

                Next j

            Next i

            Dim v As Variant

            v = ss(outv)

            Dim outsht As Worksheet

            Set outsht = m.Sheets("청라")

            Dim LAST_ROW As Integer

            LAST_ROW = outsht.Cells(Rows.Count, "j").End(3).Row

            If LAST_ROW < 2 Then
                LAST_ROW = 2
            Else
                LAST_ROW = LAST_ROW + 1
            End If

            outsht.Cells(LAST_ROW, "j").Resize(UBound(v, 1), UBound(v, 2)) = v

        End If

    Next

End Sub

Function ss(ByRef arr As Variant) As Variant
    '# 행/열 변환하기 함수.
    Dim nW() As Variant

    ReDim nW(1 To UBound(arr, 2), 1 To UBound(arr, 1))

    For j = LBound(arr, 2) To UBound(arr, 2)
        
        For k = LBound(arr, 1) To UBound(arr, 1)
            
            nW(j, k) = arr(k, j)
            
        Next k
        
    Next j

    ss = nW

End Function