我想在下面进行数据转置,保持第一列“连接”到值。
Q1 Q2 Q3
Shop 1 100 90 110
Shop 2 90 110 130
Shop 1 Q1 100
Shop 1 Q2 90
Shop 1 Q3 110
Shop 2 Q1 90
Shop 2 Q2 110
Shop 2 Q3 130
我正在使用以下代码,它适用于最后两列,但我无法执行第一列。请帮忙吗?
Sub test()
Dim r As Range, c As Range, dest As Range
With Worksheets(“Sheet1”)
Set r = Range(.Range(“C2”), .Range(“C2”).End(xlDown))
For Each c in r
‘Sales
Range(c, c.End(xlToRight)).Copy
With Worksheets(“Sheet1”)
Set dest = .Cells(Rows.Count, “O”).End(xlUp).Offset(1, 0)
dest.PasteSpecial Transpose:=True
End With
‘Quarters
Worksheets(“Sheet1”).Range(“C1:E1”).Copy
With Worksheets(“Sheet1”)
Set dest = .Cells(Rows.Count, “N”).End(xlUp).Offset(1, 0)
dest.PasteSpecial Transpose:=True
End With
Next c
End With
End Sub
诀窍是将数据视为一个表格,其顶部是标题行,左侧是标题列。然后对于“内部”表中的每个数据位(即没有标题左侧和顶部的位),您希望从左侧打印单元格,然后打印上面的单元格,然后打印数据
Sub Expand(sourcerange As Range, dest As Range)
'pass this the entire table including headersas sourcerange, a single cell as dest
Dim r As Range
Dim xCol As Long 'left hand column as number
Dim yRow As Long 'top row as number
xCol = sourcerange.Cells(1, 1).Column
yRow = sourcerange.Cells(1, 1).Row
With sourcerange.Parent
For Each r In .Range(sourcerange.Cells(2, 2), .Cells(sourcerange.Rows.Count + yRow - 1, sourcerange.Columns.Count + xCol - 1))
dest = .Cells(r.Row, xCol)
dest.Offset(0, 1) = .Cells(yRow, r.Column)
dest.Offset(0, 2) = r
Set dest = dest.Offset(1, 0)
Next r
End With
End Sub