矩陣資料轉置的疑問 - Excel程式區

[發問] 矩陣資料轉置的疑問

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2015-4-1 17:15 | 顯示全部帖子

回復 1# fusayloveme

Option Explicit
Sub Ex()
Dim Rng As Range, Ar(), i As Integer
With Sheets("2013")
Set Rng = .Range("A1:C1").Resize(.[A1].End(xlDown).Row) 'End(xlDown) '項目可延伸
Ar = .Range("D1").Resize(Rng.Rows.Count, .[D1].End(xlToRight).Column - 3).Value '監測值
End With
With Sheets("處理後資料")
.UsedRange.Clear
.[A1:E1] = Array("日期", "測項", "測站", "時間", "測值")
For i = 2 To Rng.Rows.Count '從2列開始
With .Cells(.Rows.Count, "A").End(xlUp)
.Offset(1).Resize(UBound(Ar, 2)) = Rng.Cells(i, "A").Text '日期
.Offset(1, 1).Resize(UBound(Ar, 2)) = Rng.Cells(i, "B") '測項
.Offset(1, 2).Resize(UBound(Ar, 2)) = Rng.Cells(i, "C") '測站
'陣列導入儲存格的值為2維陣列,元素下限索引從1開始.
.Offset(1, 3).Resize(UBound(Ar, 2)) = Application.Transpose(Application.Index(Ar, 1)) '時間
.Offset(1, 4).Resize(UBound(Ar, 2)) = Application.Transpose(Application.Index(Ar, 2)) '測值
End With
Next
With .UsedRange.Borders '框線
.LineStyle = 1
.Weight = xlThin
End With
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2015-4-10 14:37 | 顯示全部帖子

本帖最後由 GBKEE 於 2015-4-10 14:40 編輯

回復 6# fusayloveme
附檔可置於壓縮檔上傳

僅能夠產出65521列的資料,你的檔案版本可能是2003.
2003的最大列數為65536,超出的列數會產生錯誤.

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。