VBA转换数据表

时间:2017-05-19 03:32:25

标签: excel vba excel-vba

尝试使用宏来完成图像中所示的任务。

enter image description here

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

想知道是否有一种方法可以在不使用循环的情况下完成上述任务?

2 个答案:

答案 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以所需格式转换此类数据。您只需要取消标记日期列。 此外,它足够动态,因此如果您稍后在数据表中添加数据,您只需刷新电源查询返回的表,新数据将显示在表中。

要了解这些步骤,请观看此简短演示视频。

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