重新排列某些列和行

时间:2012-07-19 20:18:16

标签: excel vba excel-vba pivot-table unpivot

我有一个格式如下的Excel电子表格:

Before

我一直试图将其格式化为:

After

所以我想这是一种转置(不知道怎么称呼它)。

我花了最后一个半小时试图在VBA中做到这一点并没有成功。

这只是一个如何格式化的示例,实际上大约有50,000个,所以我需要使用VBA或类似的东西来做。

有人能帮我解决这个问题吗?

4 个答案:

答案 0 :(得分:3)

使用Excel 2007,您不一定需要VBA。在数据透视表向导(Alt + D,P)中选择“多个合并范围”,然后选择“我将创建页面字段”,接下来,选择您的数据,接下来,选择“新工作表”,完成。双击数据透视表的底部RH单元格。过滤ColumnA并删除空行,过滤ColumnB并删除包含“Type”的行。在“Row”和“Column”右侧插入列并填充查找值。

答案 1 :(得分:1)

如果你对LOOKUP不太满意并且有一个可管理的范围,那么有一种替代方案会更加乏味,但如果再次需要这种“换位”并且你已经忘记了确切的方式,可能会更容易记住! / p>

  1. 按照您的范围克隆数据电子表格的副本(保留'原始'[比较Sheet1]作为备份)。
  2. 将列B和C插入每个副本(而不是Sheet1)。
  3. 在Sheet2中,将E1和E2复制到C3和D3。
  4. 在Sheet3中,将F1和F2复制到C3和D3。
  5. 在Sheet4中,将G1和G2复制到C3和D3。
  6. 根据需要重复流程3.至5.
  7. 在Sheet2中删除列F和G.
  8. 在Sheet3中删除列E和G.
  9. 在Sheet4中删除列E和F.
  10. 根据需要重复流程7.至9.
  11. 在列C和D中,在表格2和表格4中的每个范围中附加一个字母,比如'z'。
  12. 在工作表2中选择C3和D3,然后双击底部右下角。
  13. 对所有其他工作表(Sheet1除外)重复12.。
  14. 从Sheet2中删除列F和G.
  15. 从Sheet3中删除列E和G.
  16. 从Sheet4中删除列E和F.
  17. 根据需要重复过程14.至16.
  18. 在Sheet3中过滤ColumnC以获取r2z并将其复制到Sheet2的底部。
  19. 在工作表4中过滤ColumnC以获取r3z并将其复制到Sheet2的底部。
  20. 根据需要重复流程18.和19.
  21. 在Sheet2中,无需替换“z”。

答案 2 :(得分:0)

你能不能只复制和粘贴专用并选择转置?

实际上再看一下OP这不是一个直接的转置,因为你的第二个丝网印刷中的前两列不是直接转置。

最终编辑

好的 - 似乎有用......

 Option Base 1

Sub moveData()

    Dim NumIterations As Integer
    NumIterations = ThisWorkbook.Sheets("target").Cells(Rows.Count, 3).End(xlUp).Row - 2

    'get the raw data and add to an array
    Dim n As Long
    Dim m As Long
    Dim myArray() As Long
    ReDim myArray(1 To NumIterations, 1 To 3)
    For n = 1 To NumIterations
        For m = 1 To 3
            myArray(n, m) = ThisWorkbook.Sheets("target").Cells(n + 2, m + 2)
        Next m
    Next n

    Dim q As Long
    Dim r As Long
    Dim myStaticArray()
    ReDim myStaticArray(1 To NumIterations, 1 To 2)
    For q = 1 To NumIterations
        For r = 1 To 2
            myStaticArray(q, r) = ThisWorkbook.Sheets("target").Cells(q + 2, r)
        Next r
    Next q


     'spit the data back out
    Dim i As Long
    Dim j As Long
    Dim myRow As Long
    myRow = 0

    For i = 1 To NumIterations
        For j = 1 To 3

            myRow = myRow + 1

            ThisWorkbook.Sheets("answer").Cells(myRow, 1) = myStaticArray(i, 1)
            ThisWorkbook.Sheets("answer").Cells(myRow, 2) = myStaticArray(i, 2)

            If j = 1 Then
                ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r1"
                ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "11-000 - 13-000"
            ElseIf j = 2 Then
                ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r2"
                ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "15-000 - 30-000"
            ElseIf j = 3 Then
                ThisWorkbook.Sheets("answer").Cells(myRow, 3) = "r3"
                ThisWorkbook.Sheets("answer").Cells(myRow, 4) = "31-000"
            End If

            ThisWorkbook.Sheets("answer").Cells(myRow, 5) = myArray(i, j)

        Next j
    Next i

End Sub

答案 3 :(得分:0)

您可以使用PasteSpecial执行此操作,如下所示

Sheet(1).UsedRange.Select
Selection.Copy
ActiveWorkbook.Sheets.Add   'Make some room for pasting the cells in the new format 
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False