Excel中的行到列

我有一组以下格式的数据：-

注：从1月17日开始至12月17日。但是，对于这个练习，我将其限制为3个月（1月至3月）

我希望将数据转换为以下格式：-

如何使用Excel实现它

---

提前感谢。

下面类似的方法如何，使用double 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

'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

---

下面类似的方法如何，使用double 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

'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

---

这是一次性任务还是重复性任务？使用Power Query（获取和转换数据）这非常简单。您正在使用哪个版本的Excel？这是一次性任务。我正在使用Excel 2016。这是一次性任务还是重复性任务？使用Power Query（获取和转换数据）非常简单。您正在使用哪个版本的Excel？这是一次性任务。我使用的是Excel 2016。它适用于小型数据，即500行。我有大约17K排&在跑了20多分钟后，它仍然没有完成。有可能改进吗？@Bob，我已经更新了我的答案，试图让代码运行得更快，请尝试一下，。。。如果有帮助的话，你能把我的回答记下来作为答案吗？谢谢。它很有效&处理速度好得多！！！在不到5分钟的时间内完成17K行！！！做得好。它适用于小型数据，即500行。我有大约17K排&在跑了20多分钟后，它仍然没有完成。有可能改进吗？@Bob，我已经更新了我的答案，试图让代码运行得更快，请尝试一下，。。。如果有帮助的话，你能把我的回答记下来作为答案吗？谢谢。它很有效&处理速度好得多！！！在不到5分钟的时间内完成17K行！！！做得好。