Sub TEST()
Dim R&, Arr, T$, TT$, TS, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([D1], [D65536].End(xlUp)(2))
For i = 2 To UBound(Arr)
If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "") = ""
Next i
Arr = Range([A2], [A65536].End(xlUp)(2))
For i = 1 To UBound(Arr)
TT = "": T = Replace(Arr(i, 1), "=", "+")
If T = "" Then GoTo 101
For Each TS In Split(T, "+")
If TS <> "" And xD.Exists(TS & "") Then TT = TT & "、" & TS
Next
Arr(i, 1) = Mid(TT, 2)
101: Next i
[B2].Resize(UBound(Arr)) = Arr
End Sub
Option Explicit
Sub TEST()
Dim R&, Arr, T$, TT$, TS, xD, i&
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
Arr = Range([D1], [D65536].End(xlUp)(2))
'↑令Arr變數是 二維陣列,以D欄儲存格值帶入陣列
For i = 2 To UBound(Arr)
If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "") = ""
Next i
'↑設順迴圈將陣列值當key,item是空的,納入xD字典裡
Arr = Range([A2], [A65536].End(xlUp)(2))
'↑令Arr陣列換裝A欄儲存格值(不含標題列)
For i = 1 To UBound(Arr)
'↑設順迴圈
TT = "": T = Replace(Arr(i, 1), "=", "+")
'↑令TT變數是 空白,令T變數是 陣列值置換 "=" 為 "+"
If T = "" Then GoTo 101
'↑如果T變數是空白!就跳到標示101位置繼續執行(空白不處理)
For Each TS In Split(T, "+")
'↑設逐項迴圈!令TS變數是 (T變數以"+"分割後的一維陣列)陣列值
If TS <> "" And xD.Exists(TS & "") Then TT = TT & "、" & TS
'↑如果TS變數不是空白,且TS變數不在xD字典裡?
'令TS變數(字串)放在TT變數(字串)後方,以 "、" 間隔
Next
Arr(i, 1) = Mid(TT, 2)
'↑令TT變數取第2字以後的字元寫入Arr陣列裡
101: Next i
[B2].Resize(UBound(Arr)) = Arr
'↑令Arr陣列值從[B2]開始寫入儲存格裡
End Sub作者: Andy2483 時間: 2023-5-31 11:56
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
Option Explicit
Sub TEST_1() '↑
Dim Brr, Y, i&, T$, TT$, K
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([D1], [D65536].End(3))
'↑令Brr變數是 二維陣列,以D欄儲存格值帶入陣列
For i = 2 To UBound(Brr)
T = Trim(Brr(i, 1)): If T <> "" Then Y(T) = i
Next
'↑設順迴圈將陣列值當key,item是i變數,納入Y字典裡
Brr = Range([A2], [A65536].End(3))
'↑令Brr陣列換裝A欄儲存格值(不含標題列)
For i = 1 To UBound(Brr)
'↑設順迴圈
T = Replace(Trim(Brr(i, 1)), "+", "=")
'↑令T變數是陣列值去除頭尾空白字元後,再置換"+" 為 "="
If T = "" Then GoTo i01 Else: T = "=" & T & "="
'↑如果T變數是空字元,就不處理跳到標示i01位置繼續執行,
'否則就令T變數在前後各包夾一個"="符號的新字串
For Each K In Y.keys
'↑設逐項迴圈,令K變數是Y字典裡的一key
If InStr(T, "=" & K & "=") Then TT = TT & "、" & K
'↑如果T變數(字串)裡包含了 (K變數在前後各包夾一個"="符號)字串
Next
Brr(i, 1) = Mid(TT, 2): TT = ""
'↑令TT變數的第2個字元開始的字串寫入陣列裡(覆蓋原陣列值)
i01: Next
[B2].Resize(UBound(Brr)) = Brr
'↑令Brr陣列值從[B2]開始寫入儲存格裡
Set Y = Nothing: Erase Brr
'↑令釋放變數
End Sub