帖子: 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

大學生 Rank: 4

帖子: 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

Sub test()
Dim arSrc(), arDes()
arSrc = Sheets(1).[A1].CurrentRegion.Value
ReDim arDes(1 To 1 + (UBound(arSrc, 2) - 3) * (UBound(arSrc) - 1), 1 To 5)
'欄位名稱
arDes(1, 1) = "日期": arDes(1, 2) = "測項"
arDes(1, 3) = "測站": arDes(1, 4) = "時間"
arDes(1, 5) = "測值"
Dim i As Long, j As Long, r As Long
r = 2
For i = 2 To UBound(arSrc)
For j = 4 To UBound(arSrc, 2)
arDes(r, 1) = arSrc(i, 1)
arDes(r, 2) = arSrc(i, 3)
arDes(r, 3) = arSrc(i, 2)
arDes(r, 4) = arSrc(1, j)
arDes(r, 5) = arSrc(i, j)
r = r + 1
Next
Next
With Sheets.Add
With .[A1].Resize(UBound(arDes), UBound(arDes, 2))
.Value = arDes
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End With
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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

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元的贊助,人人有能力.

TOP

lpk187

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

4^#

發表於 2015-4-1 17:44 | 只看該作者

回復 1# fusayloveme

大家答案出好快，我也練習了一下

Public Sub se()
end1 = 2
時間 = [d1:aa1]
For Each rn In Range("A2:A" & Cells(Rows.Count, "a").End(xlUp).Row)
測站 = Cells(rn.Row, "B")
測項 = Cells(rn.Row, "C")
arr = Range(Cells(rn.Row, "D"), Cells(rn.Row, "AA"))
Sheets("處理後資料").Range("A" & end1).Resize(UBound(arr, 2)) = rn
Sheets("處理後資料").Range("B" & end1).Resize(UBound(arr, 2)) = 測項
Sheets("處理後資料").Range("C" & end1).Resize(UBound(arr, 2)) = 測站
Sheets("處理後資料").Range("D" & end1).Resize(UBound(arr, 2)) = Application.Transpose(時間)
Sheets("處理後資料").Range("E" & end1).Resize(UBound(arr, 2)) = Application.Transpose(arr)
end1 = UBound(arr, 2) + end1
Next
With Sheets("處理後資料").[A2].Resize(end1 - 2, 5)
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End Sub

複製代碼

TOP

fusayloveme

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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