将行转换为列

我在Excel中有以下数据: –

在这里输入图像说明

我需要把它们转换成行,最后的结果应该如下:

在这里输入图像说明

我怎样才能在Excel中做到这一点?

此代码新build工作表添加和结果。

Sub test() Dim vDB, vR() Dim Ws As Worksheet Dim r As Long, c As Long Dim i As Long, n As Long, j As Integer Set Ws = ActiveSheet With Ws r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'vDB = .Range("a1", .Cells(r, c)) vDB = .Range("b1", "j" & .Range("d" & Rows.Count).End(xlUp).Row) End With For i = 2 To UBound(vDB, 1) Step 4 For j = 4 To UBound(vDB, 2) n = n + 1 ReDim Preserve vR(1 To 7, 1 To n) vR(1, n) = vDB(i, 1) vR(2, n) = vDB(i, 2) vR(3, n) = vDB(i, j) vR(4, n) = vDB(i + 1, j) vR(5, n) = vDB(i + 2, j) vR(6, n) = vDB(i + 3, j) vR(7, n) = vDB(1, j) Next j Next i Sheets.Add Range("a1").Resize(1, 7) = Array("Managed", "Type", "On/Off Hire", "Customer", "Locaton", "Daily Opex", "Date") Range("a2").Resize(n, 7) = WorksheetFunction.Transpose(vR) End Sub 

包括支持的情况

 Sub test() Dim vDB, vR() Dim Ws As Worksheet Dim r As Long, c As Long Dim i As Long, n As Long, j As Integer Set Ws = ActiveSheet With Ws r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'vDB = .Range("a1", .Cells(r, c)) vDB = .Range("b1", "j" & .Range("d" & Rows.Count).End(xlUp).Row) End With For i = 2 To UBound(vDB, 1) Step 5 For j = 4 To UBound(vDB, 2) n = n + 1 ReDim Preserve vR(1 To 8, 1 To n) vR(1, n) = vDB(i, 1) vR(2, n) = vDB(i, 2) vR(3, n) = vDB(i, j) vR(4, n) = vDB(i + 1, j) vR(5, n) = vDB(i + 2, j) vR(6, n) = vDB(i + 3, j) vR(7, n) = vDB(i + 4, j) vR(8, n) = vDB(1, j) Next j Next i Sheets.Add Range("a1").Resize(1, 8) = Array("Managed", "Type", "On/Off Hire", "Customer", "Locaton", "Support", "Daily Opex", "Date") Range("a2").Resize(n, 8) = WorksheetFunction.Transpose(vR) End Sub