尝试使用宏来完成图像中所示的任务。
Sub test()
Dim ws, out As Worksheet
Dim cnt As Integer
Set ws = Worksheets("Sheet1")
Set out = Worksheets("Sheet2")
out.Range("A1") = "Dept"
cnt = 2
For i = 2 To 4 ' row
For j = 2 To 4 ' column
out.Range("A" & cnt) = ws.Range("A" & i)
out.Range("B" & cnt) = ws.Cells(1, j).Value
out.Range("C" & cnt) = ws.Cells(i, j).Value
cnt = cnt + 1
Next
Next
End Sub
想知道是否有一种方法可以在不使用循环的情况下完成上述任务?
答案 0 :(得分:1)
试试这段代码
Sub Transpose(ByVal WhatToTranspose As Range, ByVal WhereToPaste As Range)
Dim col As Integer 'loop through columns
Dim row As Integer 'loop through rows
Dim a() As Variant
Dim b() As Variant
Dim i As Integer
a() = WhatToTranspose
For row = 2 To UBound(a, 1)
For col = 2 To UBound(a, 2)
If a(row, col) > 0 Then
i = i + 1
ReDim Preserve b(1 To 3, 1 To i)
b(1, i) = a(row, 1)
b(2, i) = a(1, col)
b(3, i) = a(row, col)
End If
Next
Next
b() = Application.Transpose(b())
WhereToPaste.Resize(UBound(b, 1), UBound(b, 2)).Value = b()
End Sub
应该像
一样调用Sub Caller()
Transpose Range("A1:D4"), Range("F1")
End Sub
注意:我在没有测试的情况下发布此答案。如果您遇到问题,我会稍后尝试编辑此帖子
答案 1 :(得分:0)
如果您使用的是Excel 2013及更高版本,则可以使用Power Query以所需格式转换此类数据。您只需要取消标记日期列。 此外,它足够动态,因此如果您稍后在数据表中添加数据,您只需刷新电源查询返回的表,新数据将显示在表中。
要了解这些步骤,请观看此简短演示视频。