- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
本帖最後由 Andy2483 於 2022-10-17 13:53 編輯
謝謝 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 |
|
發表於 2022-10-17 13:52
| 
