重新排列某些列和行

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

之前

我一直在试图做的是格式化它看起来像这样:

后

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

我花了一个半小时的时间试图在VBA中取得成功。

这只是格式化的一个例子,实际上大概有五万个,所以我需要用VBA或者其他类似的软件来做。

有人能帮助我如何做到这一点?

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

如果你对LOOKUP不太满意,并且有一个可以pipe理的范围数量,那么有一个替代scheme比较单调,但是如果再次需要这样的“换位”,并且你已经完全忘记了,可能会更容易记住!

  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中selectC3和D3,然后双击底部的RH转angular。
  13. 重复12.对于所有其他纸张(Sheet1除外)。
  14. 从Sheet2中删除F和G列。
  15. 从Sheet3中删除列E和G.
  16. 从Sheet4中删除列E和F.
  17. 根据需要重复过程14.至16.
  18. 将Sheet2中的ColumnC过滤为r2z,并将可见复制到Sheet2的底部。
  19. 在表4中过滤ColumnC以获取r3z,并将可见复制到Sheet2的底部。
  20. 重复过程18.和19.如有必要。
  21. 在Sheet2中,用“z”代替。

你可以使用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 

你能不能只复制和粘贴特殊的转置?

实际上再看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