將單列文本分爲多列

我試圖創建一個宏，它將根據項目類型將一列中的數據分爲多列。我試圖分類的數據是合同中有關項目元數據的合同列表。將單列文本分爲多列

的原始數據是這樣的：

 
Contract No Contract Name   Item Type Item Description 
111111  Chocolate Supplies  POTS  5" 
111111  Chocolate Supplies  POTS  10" 
111111  Chocolate Supplies  POTS  15" 
111111  Chocolate Supplies  PANS  5" 
111111  Chocolate Supplies  PANS  10" 
111111  Chocolate Supplies  PANS  15" 
111111  Chocolate Supplies  KNIVES  Paring knife 
111111  Chocolate Supplies  SILVERWARE Salad fork 
111111  Chocolate Supplies  SILVERWARE Dinner fork 
111111  Chocolate Supplies  SILVERWARE Dessert fork 
111111  Chocolate Supplies  SILVERWARE Dessert spoon 
111111  Chocolate Supplies  SILVERWARE Soup spoon 
22222  Soups and Salads Order  POTS  10" 
22222  Soups and Salads Order  POTS  15" 
22222  Soups and Salads Order  PANS  15" 
22222  Soups and Salads Order  KNIVES  Butter knife 
22222  Soups and Salads Order  KNIVES  Bread knife 
22222  Soups and Salads Order  KNIVES  Paring knife 
22222  Soups and Salads Order  SILVERWARE Soup spoon

的最終數據需要看起來像這樣（編輯成包括圖像）： Final Format of Report

 
Contract Contract Name   POTS PANS KNIVES   SILVERWARE 
111111  Chocolate Supplies  5"  5"  Paring knife Salad fork 
            10"  10"      Dinner fork       
            15"  15"      Dessert fork 
                    Dessert spoon 
                    Soup spoon 
22222  Soups and Salads Order 10"  15"  Butter knife Soup spoon 
            15"    Bread knife 
                Paring knife

＃我一直如此遠＃
我目前使用的原油解決方案是：
- 運行查詢
- 將數據粘貼到Excel
- 創建樞軸
- 使用一系列計數，根據需要
偏移和間接公式來重新組織數據 - 由於上述過程留下合同的每個部分之間的空行，我將數據複製粘貼到新的工作表中，放置一個自動過濾器並刪除空白行
...和瞧，這是最終報告。

＃可能的解決方案VBA＃
我發現this tutorial這似乎做正是我想要的，除了我需要宏開始一個新的部分問題時，合同沒有。變化。我不知道如何獲得下面的VBA代碼來檢查合同號。

我很樂意提供任何幫助。提前致謝！

＃代碼從tutorial on get-digital-help [dot] com由奧斯卡。＃
這是不是我的代碼，我完全稱讚奧斯卡的教程讓我朝着正確的方向前進。

Sub Categorizedatatocolumns() 
Dim rng As Range 
Dim dest As Range 
Dim vrb As Boolean 
Dim i As Integer 
Set rng = Sheets("Sheet1").Range("A4") 
vrb = False 
Do While rng <> "" 
Set dest = Sheets("Sheet1").Range("A20") 
Do While dest <> "" 
If rng.Value = dest.Value Then 
vrb = True 
End If 
Set dest = dest.Offset(0, 1) 
Loop 
If vrb = False Then 
dest.Value = rng.Value 
dest.Font.bold = True 
End If 
vrb = False 
Set rng = rng.Offset(1, 0) 
Loop 
Set rng = Sheets("Sheet1").Range("A4") 
Do While rng <> "" 
Set dest = Sheets("Sheet1").Range("A20") 
Do While dest <> "" 
If rng.Value = dest.Value Then 
i = 0 
Do While dest <> "" 
Set dest = dest.Offset(1, 0) 
i = i + 1 
Loop 
Set rng = rng.Offset(0, 1) 
dest.Value = rng.Value 
Set rng = rng.Offset(0, -1) 
Set dest = dest.Offset(-i, 0) 
End If 
Set dest = dest.Offset(0, 1) 
Loop 
Set rng = rng.Offset(1, 0) 
Loop 
End Sub

來源

2013-10-24 Laurie