Транспонировать неравные столбцы Excel в строки

Question

Транспонировать неравные столбцы Excel в строки

Я получил таблицу Excel с различным количеством элементов в категории:

Category A   Category B   Category C
22           11           1
34           15           6
55           4            18
33
36

Я хотел бы превратить это в:

Category     Item
Category A   22
Category A   34
Category A   55
Category A   33
Category A   36
Category B   11
Category B   15
[...]

Какой быстрый способ достижения этого?

1

microsoft-excel transpose

Источник

Dan 03 окт '12 в 11:45

1 ответ

Решение

Другие вопросы по тегам microsoft-excel transpose

nutsch 03 окт '12 в 17:57 2012-10-03 17:57 · Accepted Answer · 2012-10-03 17:57

Макрос сделает это легко. Макрос ниже поместит результат в новый лист.

Sub TransposeStuff()
Dim lLastRow As Long, lColLoop As Long, lLastCol As Long
Dim shtOrg As Worksheet, shtDest As Worksheet

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


Set shtOrg = ActiveSheet
Set shtDest = Sheets.Add

shtDest.[a1] = "Category"
shtDest.[B1] = "Item"

lLastCol = shtOrg.Cells(1, Columns.Count).End(xlToLeft).Column


For lColLoop = 1 To lLastCol
    lLastRow = shtOrg.Cells(Rows.Count, lColLoop).End(xlUp).Row

    shtOrg.Range(shtOrg.Cells(2, lColLoop), shtOrg.Cells(lLastRow, lColLoop)).Copy
        shtDest.Cells(Rows.Count, 2).End(xlUp).Offset (1)

    shtDest.Range(shtDest.Cells(Rows.Count, 1).End(xlUp).Offset(1), _
                    shtDest.Cells(Rows.Count, 2).End(xlUp).Offset(, -1)).Value = shtOrg.Cells(1, lColLoop)

Next lColLoop

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub