Строка в столбец в Excel

Question

У меня есть набор данных в этом формате: -

Примечание: он начинается с 17 января по 17 декабря.Однако для этого упражнения я ограничу его 3 месяцами (с января по март).

Я хочу преобразовать данные в этот формат: -

Как мне добиться этого с помощью Excel?

Заранее спасибо.

Answer 1

Как насчет чего-то подобного ниже, используя двойной цикл For для циклического прохождения по строкам, а затем по столбцам и передачи данных на Sheet2 в нужном формате (это не добавит заголовки к Sheet2, но даст вам некоторые рекомендации, как как это сделать):

Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

For i = 2 To LastRow 'loop through rows
    For col = 6 To 14 Step 4 'loop through columns
    'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
        FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
        ws.Range("A" & i & ":D" & i).Copy ws2.Range("A" & FreeRow) 'copy the first 4 columns into the free row
        ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
        ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
        ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
        ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
        ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
        ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
    Next col
Next i
End Sub

UPDATE:

Я добавил пару строк в код, чтобы попытаться оптимизировать его скорость, также удалил Copy & Paste и изменил его, чтобы передать значения без копирования, пожалуйста, посмотрите ниже:

Sub Summarize()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Sheet with data
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") 'Summarised Sheet
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

'optimize code:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

For i = 2 To LastRow 'loop through rows
    For col = 6 To 14 Step 4 'loop through columns
    'replace 14 with (LastCol - 4) if you wish to do all the months instead of just the first 3
        FreeRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1 'get the next free row to transfer data to
        ws2.Cells(FreeRow, 1).Value = ws.Cells(i, 1).Value
        ws2.Cells(FreeRow, 2).Value = ws.Cells(i, 2).Value
        ws2.Cells(FreeRow, 3).Value = ws.Cells(i, 3).Value
        ws2.Cells(FreeRow, 4).Value = ws.Cells(i, 4).Value
        ws2.Cells(FreeRow, 5).Value = "20" & Mid(ws.Cells(1, col).Value, 5, 2) 'get the year from the header
        ws2.Cells(FreeRow, 6).Value = Left(ws.Cells(1, col).Value, 3) ' get the month name from header
        ws2.Cells(FreeRow, 7).Value = ws.Cells(i, col).Value 'transfer values
        ws2.Cells(FreeRow, 8).Value = ws.Cells(i, col + 1).Value
        ws2.Cells(FreeRow, 9).Value = ws.Cells(i, col + 2).Value
        ws2.Cells(FreeRow, 10).Value = ws.Cells(i, col + 3).Value
    Next col
Next i

'return to normal Excel status after macro has finished
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub