n列后的VBA转置表

时间:2014-09-18 05:10:02

标签: excel excel-vba vba

我有一张看起来像这样的表:

+---------+------------+--------+------+------+------+------+------+------+------+------+
| country |    date    | proces | val1 | val2 | val3 | val4 | val5 | val6 | val7 | val8 |
+---------+------------+--------+------+------+------+------+------+------+------+------+
| iso 1   | 11.03.2010 | over   |  111 |  222 |  222 |  333 |  444 |  555 |  666 |  777 |
| iso 2   | 11.03.2011 | over   |  111 |  222 |  222 |  333 |  444 |  555 |  666 |  777 |
+---------+------------+--------+------+------+------+------+------+------+------+------+

我想将其改为:

+---------+------------+--------+-----+
| country |    date    | proces | val |
+---------+------------+--------+-----+
| iso 1   | 11.03.2010 | over   | 111 |
| iso 1   | 11.03.2010 | over   | 222 |
| iso 1   | 11.03.2010 | over   | 222 |
| iso 1   | 11.03.2010 | over   | 333 |
| iso 1   | 11.03.2010 | over   | 444 |
| iso 1   | 11.03.2010 | over   | 555 |
| iso 1   | 11.03.2010 | over   | 666 |
| iso 1   | 11.03.2010 | over   | 777 |
| iso 2   | 11.03.2011 | over   | 111 |
| iso 2   | 11.03.2011 | over   | 222 |
| iso 2   | 11.03.2011 | over   | 222 |
| iso 2   | 11.03.2011 | over   | 333 |
| iso 2   | 11.03.2011 | over   | 444 |
| iso 2   | 11.03.2011 | over   | 555 |
| iso 2   | 11.03.2011 | over   | 666 |
| iso 2   | 11.03.2011 | over   | 777 |
+---------+------------+--------+-----+

我已经看到可以使用Office 03中的Pivot Table Wizard来完成。我正在寻找一个宏或有人解释如何建立一个。我是该领域的新秀,但目前正在学习如何构建自己的宏。我倾向于理解我正在阅读的代码,我只是很难弄清楚如何自己写。

2 个答案:

答案 0 :(得分:0)

尝试类似的东西......

Sub Make()
    e = 2
    While Range("A" & e).Value <> ""
        If Range("E" & e).Value <> "" Then
            For i = 8 To 1 Step -1
                Range(e + 1 & ":" & e + 1).Insert xlShiftDown
                Range("A" & e + 1).Value = Range("A" & e).Value
                Range("B" & e + 1).Value = Range("B" & e).Value
                Range("C" & e + 1).Value = Range("C" & e).Value
                Range("D" & e + 1).Value = Cells(3 + i).Value
            Next
            Range(e & ":" & e).Delete
        End If
        e = e + 1
    Wend
End Sub

答案 1 :(得分:0)

点击Alt+F11,当VBE打开时,立即使用下拉菜单 Insert,Module 。将以下内容粘贴到标题为Book1 - Module1(Code)的新窗格中。

Sub Transpose_ISO()
    Dim r As Long, lr As Long, rw As Long, c As Long, lc As Long, iBaseCols As Long
    iBaseCols = 3  'set to the number of semi-static column to repeat
    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        rw = lr + 2
        .Cells(rw, 1).Resize(1, iBaseCols).Formula = "=""fld ""&SUBSTITUTE(ADDRESS(1, COLUMN(A:A), 4, 1), 1, TEXT(,))"
        .Cells(rw, iBaseCols + 1) = "val"
        For r = 2 To lr
            For c = (iBaseCols + 1) To lc
                rw = rw + 1
                .Cells(rw, 1).Resize(1, iBaseCols) = .Cells(r, 1).Resize(1, iBaseCols).Value
                .Cells(rw, iBaseCols + 1) = .Cells(r, c).Value
            Next c
        Next r
    End With
End Sub

点按Alt+Q返回工作表,然后点按ALt+F8以打开“宏”对话框,然后运行宏。

您的结果应与下图中的结果类似。请注意,转置结果将低于当前数据块。

enter image description here