返回列表 上一主題 發帖

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

fusayloveme

帖子
46 
主題
12 
精華
0 
積分
72 
點名
0  
作業系統
win7 
軟體版本
2007-EXCEL 
閱讀權限
20 
性別
男 
註冊時間
2011-12-29 
最後登錄
2020-3-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-4-1 14:24 | 只看該作者

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

各位版上的大大，想請教如何將附件中的矩陣資料，進行資料轉置成成資料庫格式呢?

嘗試過土法煉鋼的錄製後修改，但步驟繁瑣，想上來問看版上的大大是否有更好的辦法，謝謝。

資料如附件 監測資料.rar (9.44 KB)

SHEET1 為原始資料 SHEET2 希望資料生成的形式，先謝各位的幫忙。
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2015-4-1 16:35 | 只看該作者
回復 1# fusayloveme
  1. Sub test()
  2.     Dim arSrc(), arDes()
  3.    
  4.     arSrc = Sheets(1).[A1].CurrentRegion.Value
  5.     ReDim arDes(1 To 1 + (UBound(arSrc, 2) - 3) * (UBound(arSrc) - 1), 1 To 5)
  6.     '欄位名稱
  7.     arDes(1, 1) = "日期": arDes(1, 2) = "測項"
  8.     arDes(1, 3) = "測站": arDes(1, 4) = "時間"
  9.     arDes(1, 5) = "測值"
  10.         
  11.     Dim i As Long, j As Long, r As Long
  12.     r = 2
  13.     For i = 2 To UBound(arSrc)
  14.         For j = 4 To UBound(arSrc, 2)
  15.             arDes(r, 1) = arSrc(i, 1)
  16.             arDes(r, 2) = arSrc(i, 3)
  17.             arDes(r, 3) = arSrc(i, 2)
  18.             arDes(r, 4) = arSrc(1, j)
  19.             arDes(r, 5) = arSrc(i, j)
  20.             r = r + 1
  21.         Next
  22.     Next
  23.    
  24.     With Sheets.Add
  25.         With .[A1].Resize(UBound(arDes), UBound(arDes, 2))
  26.             .Value = arDes
  27.             .Borders.LineStyle = xlContinuous
  28.             .Borders.Weight = xlThin
  29.         End With
  30.     End With
  31.    
  32. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2015-4-1 17:15 | 只看該作者
回復 1# fusayloveme
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, Ar(), i As Integer
  4.     With Sheets("2013")
  5.         Set Rng = .Range("A1:C1").Resize(.[A1].End(xlDown).Row)  'End(xlDown) '項目可延伸
  6.         Ar = .Range("D1").Resize(Rng.Rows.Count, .[D1].End(xlToRight).Column - 3).Value '監測值
  7.     End With
  8.     With Sheets("處理後資料")
  9.         .UsedRange.Clear
  10.         .[A1:E1] = Array("日期", "測項", "測站", "時間", "測值")
  11.         For i = 2 To Rng.Rows.Count         '從2列開始
  12.            With .Cells(.Rows.Count, "A").End(xlUp)
  13.                 .Offset(1).Resize(UBound(Ar, 2)) = Rng.Cells(i, "A").Text    '日期
  14.                 .Offset(1, 1).Resize(UBound(Ar, 2)) = Rng.Cells(i, "B")      '測項
  15.                 .Offset(1, 2).Resize(UBound(Ar, 2)) = Rng.Cells(i, "C")      '測站
  16.                 '陣列導入儲存格的值為2維陣列,元素下限索引從1開始.
  17.                 .Offset(1, 3).Resize(UBound(Ar, 2)) = Application.Transpose(Application.Index(Ar, 1))      '時間
  18.                 .Offset(1, 4).Resize(UBound(Ar, 2)) = Application.Transpose(Application.Index(Ar, 2))      '測值
  19.            End With
  20.         Next
  21.         With .UsedRange.Borders   '框線
  22.             .LineStyle = 1
  23.             .Weight = xlThin
  24.         End With
  25.     End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
4#
發表於 2015-4-1 17:44 | 只看該作者
回復 1# fusayloveme

大家答案出好快，我也練習了一下
  1. Public Sub se()
  2. end1 = 2
  3. 時間 = [d1:aa1]
  4. For Each rn In Range("A2:A" & Cells(Rows.Count, "a").End(xlUp).Row)
  5.     測站 = Cells(rn.Row, "B")
  6.     測項 = Cells(rn.Row, "C")
  7.     arr = Range(Cells(rn.Row, "D"), Cells(rn.Row, "AA"))
  8.     Sheets("處理後資料").Range("A" & end1).Resize(UBound(arr, 2)) = rn
  9.     Sheets("處理後資料").Range("B" & end1).Resize(UBound(arr, 2)) = 測項
  10.     Sheets("處理後資料").Range("C" & end1).Resize(UBound(arr, 2)) = 測站
  11.     Sheets("處理後資料").Range("D" & end1).Resize(UBound(arr, 2)) = Application.Transpose(時間)
  12.     Sheets("處理後資料").Range("E" & end1).Resize(UBound(arr, 2)) = Application.Transpose(arr)
  13.     end1 = UBound(arr, 2) + end1
  14. Next
  15. With Sheets("處理後資料").[A2].Resize(end1 - 2, 5)
  16.     .Borders.LineStyle = xlContinuous
  17.     .Borders.Weight = xlThin
  18. End With
  19. End Sub
複製代碼

TOP

fusayloveme

帖子
46 
主題
12 
精華
0 
積分
72 
點名
0  
作業系統
win7 
軟體版本
2007-EXCEL 
閱讀權限
20 
性別
男 
註冊時間
2011-12-29 
最後登錄
2020-3-20 
5#
發表於 2015-4-2 15:23 | 只看該作者
回復 2# stillfish00

回復 3# GBKEE

回復 4# lpk187

感謝S大、G大及L大的幫忙，目前嘗試都可以用喔~

S大的    arDes(1, 1) = "日期": arDes(1, 2) = "測項"
    arDes(1, 3) = "測站": arDes(1, 4) = "時間"
    arDes(1, 5) = "測值"
跟
G大的 [A1:E1] = Array("日期", "測項", "測站", "時間", "測值")

讓我學到了不一樣的思考邏輯，感謝你們的幫忙~ ^^~

TOP

fusayloveme

帖子
46 
主題
12 
精華
0 
積分
72 
點名
0  
作業系統
win7 
軟體版本
2007-EXCEL 
閱讀權限
20 
性別
男 
註冊時間
2011-12-29 
最後登錄
2020-3-20 
6#
發表於 2015-4-9 15:01 | 只看該作者
回復 3# GBKEE

G大不好意思，想跟您請教一下。

因一開始是用兩個列的資料供嘗試，但實際操作上大約每次會有6993列的資料量

因此經過矩陣後，約有6993*24=167832列的資料量

但使用巨集後，僅能夠產出65521列的資料，如附件檔案(工作表11)

想請問這是EXCEL的限制? 還是有其他方式? 先謝謝您的協助。

附件檔案(GOOGLE 雲端)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2015-4-10 14:37 | 只看該作者
本帖最後由 GBKEE 於 2015-4-10 14:40 編輯

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

僅能夠產出65521列的資料,你的檔案版本可能是2003.
2003的最大列數為65536,超出的列數會產生錯誤.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Scott090

帖子
508 
主題
53 
精華
0 
積分
583 
點名
82  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2024-4-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
8#
發表於 2015-4-17 07:56 | 只看該作者
回復 6# fusayloveme

Application.Transpose() 這種工作表函數能處理的範圍是 65536
給參考

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題