Sub TEST()
Dim Arr, D, T$, R&, C&
'↑宣告變數
Arr = Range("A2:F" & [A65536].End(3).Row)
'↑令Arr變數是二維陣列,以儲存格值帶入陣列裡
Set D = CreateObject("Scripting.Dictionary")
'↑令D變數是字典
For C = 1 To UBound(Arr, 2) Step 2
'↑設順迴圈跑欄!每繞回一次 +2 (1,3,5,.....)
For R = 1 To UBound(Arr)
'↑設順迴圈跑列!
T = Arr(R, C): If T = "" Then GoTo 101
'↑令T變數是迴圈的Arr陣列值
'如果T變數是空字元!就跳到101標示位置繼續執行(空白不處理)
If C = 1 Then D(T) = R: GoTo 101
'↑如果C變數是1!就令以T變數當key,item是R變數(索引列號),
'跳到101標示位置繼續執行
Arr(R, C) = "": Arr(R, C + 1) = ""
'↑令處理過的陣列位置清除
'(因為用同一陣列放原資料調整為新資料)
Arr(D(T), C) = T
'↑令T變數查D字典得item值列第C變數欄Arr陣列值是 T變數
Arr(D(T), C + 1) = Arr(D(T), 2)
'↑令右側欄Arr陣列值是Arr陣列第2欄值
101: Next
Next
[期望結果示意!A3:F3].Resize(UBound(Arr)) = Arr
'↑令Arr陣列值寫入另一個工作表
End Sub
發表於 2023-5-11 14:12
| 
