重新排列某些列和行

我有一个Excel电子表格格式如下：重新排列某些列和行

Before

我一直试图做的是格式，它看起来像这样：

After

所以这是一种转置我猜（不知道如何调用它）。

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

这仅仅是它如何格式化的一个例子，实际上大约有5万个，所以我需要使用VBA或类似的东西。

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

来源

2012-07-19 BadgerBeaz

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

来源

2012-07-20 00:08:08 pnuts

+1我喜欢通过内置工具解决这个问题的想法...更简单和更快 - 我的回答并不简单（我只是喜欢玩玩数组，第一次在很长一段时间！） – whytheq 2012-07-20 09:32:55

@whytheq谢谢。我更喜欢避免VBA，主要是因为安全性，但其他原因包括更好的人了解内置的内容，可以实现更快的其他结果。例如，这个答案实际上只是SU 78439的一个变体。至于'数组' - 去做吧！ – pnuts 2012-07-20 11:30:32

@pnuts谢谢你，我想我到了那里，但我真的不知道如何填充插入列的查找值？ – BadgerBeaz 2012-07-20 14:33:06

你不能只复制和粘贴特殊和选择转置吗？

实际上再次看OP，这不是一个直的转置，因为你的第二个screenprint中的前两列不是直接转置。

最后编辑

好了 - 似乎工作...

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

来源

2012-07-19 20:21:06 whytheq

是啊多数民众赞成在我认为太谢谢你的答案虽然:) – BadgerBeaz 2012-07-19 20:25:27

这张桌子总是相同的宽度？ – whytheq 2012-07-19 20:33:36

是的，我有大约15那些r1，r2，r3列 – BadgerBeaz 2012-07-20 02:16:22

您可以用它做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

来源

2012-07-19 20:25:52 Ahmad

我得到“选择范围类失败的方法”错误发生在Sheet（1）.UsedRange.Select行 – BadgerBeaz 2012-07-20 02:19:28

如果您对LOOKUP并有范围管理的数量存在着比较繁琐一点，但可能会更容易记住，如果这样的“换位”再次需要和你已经忘记了究竟如何！

克隆为一体的多份替代数据电子表格，因为您有范围（保留'原始'[说Sheet1]作为备份）。
插入列B和C到每个副本（不Sheet1）
在工作表2中，将E1和E2复制到C3和D3。
在工作表3中，将F1和F2复制到C3和D3。
在工作表4中，将G1和G2复制到C3和D3。
根据需要重复过程3.至5.。
Sheet 2中删除列F和G
在表Sheet 3删除列E和G.
在Sheet4删除列E和F.
重复该过程。
在列C和D中，向每个表格2到4中的范围编号和值添加一个字母，说'z'。
在工作表2中选择C3和D3，然后双击底部RH拐角。
重复12.对于所有其他纸张（Sheet1除外）。
删除Sheet2中的F和G列。
删除Sheet3中的E和G列。
从Sheet4中删除列E和F.
必要时重复过程14.至16.。
将Sheet2中的ColumnC过滤为r2z，并将复制可见到Sheet2的底部。
对于r3z，在Sheet 4中过滤ColumnC，并将复制可见到Sheet2的底部。
根据需要重复步骤18.和19.。
在Sheet2中，用'z'代替。

来源

2012-07-23 15:05:41 pnuts

重新排列某些列和行

回答

相关问题