重新排列某些列和行

我有一個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

重新排列某些列和行

回答

相關問題