VBA转换数据表

试图用macros来完成图像中显示的任务。

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 

想知道是否有一个不使用循环完成上述任务的方法？

Answer 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 

注意：我发布这个答案没有testing。 如果你有问题，我会尽力编辑这个post

Answer 2

如果您使用Excel 2013及更高版本，则可以使用Power Query以所需格式转换此类数据。 你只需要取消date列。 此外，它是足够dynamic的，以便如果您稍后在数据表中添加数据，只需刷新电源查询返回的表，新数据将显示在表中。

要了解这些步骤，请观看这​​个简短的演示video。

https://www.screencast.com/t/8beXtAJcgX5