在資料收集整理階段， 經常會遇到各種特殊情況， 矩陣型資料是其中之一。
所謂矩陣型資料， 就是這種本來只有一列的資料，
換句話說就是， 將資料其中的一個維度給提升了， 變成了標籤， 這樣形成矩陣。
這種資料的弊端是， 要提取其中的資料非常不方便
用函數來提取， 要變非常複雜的公式， INDEX,MATCH,ROW,COLUMN組合公式。
想想就頭疼。
那麼沒有解決方案麼？
當然有， 我們用一個不明覺厲的詞“降維打擊”
我們這裡所說的降維是指， 將本來應該作為屬性的標籤， 給改回來， 把資料從矩陣改成一列。
當然， 這說起來容易， 真的要手動， 一列一列的複製粘貼，
也不是件令人愉快的工作。
我們不是還有秘密武器麼---Excel降維處理工具
這樣是不是很容易就實現了矩陣資料轉一維資料。
附上代碼：
Sub 資料整理()
Dim Finalrow, Finalcol As Long
Dim Nrow, Ncol As Long
Dim Dbbook As Workbook, Basewks As Worksheet
Dim Fname As Variant
Dim Fnum As Integer
Dim Res As Boolean
Dim i, j As Integer
Dim k, li As Long
Dim x, y
'修改螢幕更新,計算模式和啟用事件的狀態
Res = MsgBox(在打開的視窗選擇資料表, vbOKOnly, 檔選擇提示)
'選擇“輔助表”與“銷售資料”
Fname = Application.GetOpenFilename(filefilter:=Excel Files (*.xl*), *.xl*, _
MultiSelect:=True)
For Fnum = LBound(Fname) To UBound(Fname)
'打開資料表
Set Dbbook = Workbooks.Open(Fname(Fnum), UpdateLinks:=0)
Next
Dbbook.Activate
Set Basewks = Dbbook.Worksheets(1)
Basewks.Select
x = InputBox(請問：從哪一列開始插入列(A,B,C...)？)
y = Chr(Asc(x) + 1)
Range(x : y).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range(x 1).FormulaR1C1 = '數量
Range(y 1).FormulaR1C1 = '系列
Ncol = Basewks.UsedRange.Columns.Count
Finalcol = Basewks.UsedRange.Columns(Ncol).Column
Nrow = ActiveSheet.UsedRange.Rows.Count
Finalrow = ActiveSheet.UsedRange.Rows(Nrow).Row
li = Range(y 1).Column + 1
k = Finalrow
j = 0
For i = li To Finalcol
'查找最後一行
Nrow = ActiveSheet.UsedRange.Rows.Count
Finalrow = ActiveSheet.UsedRange.Rows(Nrow).Row
Range(Cells(2, i), Cells(k, i)).Select
Selection.Copy
Cells(j + 2, li - 2).Select
ActiveSheet.Paste
Cells(1, i).Select
Application.CutCopyMode = False
Selection.Copy
Range(Cells(j + 2, li - 1), Cells(j + k, li - 1)).Select
ActiveSheet.Paste
j = j + k - 1
Next
'關閉資料表， 保存
'dbbook.Close savechanges:=True
Nrow = ActiveSheet.UsedRange.Rows.Count
Finalrow = ActiveSheet.UsedRange.Rows(Nrow).Row
Range(Cells(2, 1), Cells(k, li - 3)).Select
Application.CutCopyMode = False
Selection.Copy
Range(Cells(k + 1, 1), Cells(Finalrow, 3)).Select
ActiveSheet.Paste
Range(Cells(1, li), Cells(Finalrow, Finalcol)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
End Sub