DDD = .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp)).Address
For Each B In .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp))
'↑設內迴圈,令 B儲存格物件變數:A標題列格偏下1格到 當欄的最後一格
'當i=0(初始值);Sh=Sheet1;A=[A1];B=[A2:A105]
'所以 B Sheet1 的[A2:A105]的儲存格之一
If i = 0 Then
'↑如果i是初始值0,也就是工作表是 Sheet1 時
'目的是要收集標題欄兩欄的值與 日期&股代號&標題列格 拚字串的key,Item是 CreditMoney欄值
謝謝 Hsieh 前輩
謝謝 n7822123 前輩
以下心得註解,懇請前輩們指正與指導!
Option Explicit
Sub TEST()
Dim Arr, Brr, C&, i&, R&, T, Y, Z, Q
Set Y = CreateObject("Scripting.Dictionary")
Sheets("Sheet5").Cells = ""
'↑令 工作表 "Sheet5" 所有儲存個都是空字元
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet1")
Set Brr = .[A1].CurrentRegion
'↑令 Brr是 [A1]相鄰非空格所串連起來的儲存格,擴展到方正區域的最小範圍儲存格
C = .[A1].End(xlToRight).Column
'↑令C是此表的欄數
R = .[A1].End(xlDown).Row
'↑令R是此表的列數
End With
For i = 1 To R
'↑設迴圈把一維陣列倒入字典裡當item
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 1).Resize(, C)
Arr = Application.Transpose(Application.Transpose(Arr))
Y(T & "|" & Q) = Arr
'↑令此KEY的ITEM是Arr一維陣列
Next
With Sheet5
.[A1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'↑把Y字典的一維陣列ITEM值從[A1]開始貼入
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet2")
Set Brr = .Range(.[D1], .[A1].End(xlDown))
C = .[A1].End(xlToRight).Column - 2
R = .[A1].End(xlDown).Row
End With
For Each Z In Y.KEYS
'↑設迴圈把item的一維陣列改變陣列大小
'這裡很重要!
'因為如果最後轉置貼上時!字典ITEM的集合不是方正的
'就沒辦法轉置貼上
Y(Z) = Array("", "")
Next
For i = 1 To R
'↑設迴圈把一維陣列倒入字典裡當item
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 3).Resize(, C)
Arr = Application.Transpose(Application.Transpose(Arr))
If Y.Exists(T & "|" & Q) Then
'↑如果組合字串在字典裡有!
Y(T & "|" & Q) = Arr
'↑條件成立就令此KEY的ITEM是Arr一維陣列
End If
Next
With Sheet5
.[I1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'↑把Y字典的一維陣列ITEM值從[I1]開始貼入
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet3")
Set Brr = .Range(.[K1], .[A1].End(xlDown))
C = .[A1].End(xlToRight).Column
R = .[A1].End(xlDown).Row
End With
For Each Z In Y.KEYS
'↑設迴圈把item的一維陣列改變陣列大小
'這裡很重要!
'因為如果最後轉置貼上時!字典ITEM的集合不是方正的
'就沒辦法轉置貼上
Y(Z) = Split(",,,,,,,,,,", ",")
Next
For i = 1 To R
'↑設迴圈把一維陣列倒入字典裡當item
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 1).Resize(, C) '
Arr = Application.Transpose(Application.Transpose(Arr))
If Y.Exists(T & "|" & Q) Then
'↑如果組合字串在字典裡有!
Y(T & "|" & Q) = Arr
'↑條件成立就令此KEY的ITEM是Arr一維陣列
End If
Next
With Sheet5
.[K1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'↑把Y字典的一維陣列ITEM值從[K1]開始貼入
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet4")
Set Brr = .Range(.[R1], .[A1].End(xlDown))
C = .[A1].End(xlToRight).Column - 2
R = .[A1].End(xlDown).Row
End With
For Each Z In Y.KEYS
'↑設迴圈把item的一維陣列改變陣列大小
'這裡很重要!
'因為如果最後轉置貼上時!字典ITEM的集合不是方正的
'就沒辦法轉置貼上
Y(Z) = Split(",,,,,,,,,,,,,,,", ",")
Next
For i = 1 To R
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 3).Resize(, C)
Arr = Application.Transpose(Application.Transpose(Arr))
If Y.Exists(T & "|" & Q) Then
'↑如果組合字串在字典裡有!
Y(T & "|" & Q) = Arr
'↑條件成立就令此KEY的ITEM是Arr一維陣列
End If
Next
With Sheet5
.[V1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'↑把Y字典的一維陣列ITEM值從[V1]開始貼入
End With
Set Arr = Nothing
Set Brr = Nothing
Set Y = Nothing
End Sub作者: Andy2483 時間: 2022-10-17 14:47
本帖最後由 Andy2483 於 2022-10-17 14:58 編輯
各位前輩好:
後學發現一個很有意思的現象
請教各位前輩這是什麼邏輯?
1.不轉置貼入沒有資料
.[V1].Resize(Y.Count, C) = Y.items
2.轉置一次!資料是橫放
.[V1].Resize(Y.Count, C) = Application.Transpose(Y.items)
3.轉置兩次才會是我們要的資料!
.[V1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
4.轉置三次同2.
.[V1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Application.Transpose(Y.items)))
5.轉置4次又同3.
.[V1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Application.Transpose(Application.Transpose(Y.items))))
