Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/27.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/9/three.js/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
带倒填的VBA转置_Vba_Excel - Fatal编程技术网

带倒填的VBA转置

带倒填的VBA转置,vba,excel,Vba,Excel,我想做下面的数据转换,保持第一列与值“连接” 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

我想做下面的数据转换,保持第一列与值“连接”

        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

您可以完全跳过VBA,然后