返回列表 上一主題 發帖

[發問] 字串刪除重複

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1425 
主題
40 
精華
0 
積分
1449 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-4-16 
1# 跳轉到 »
發表於 2023-5-16 16:14 | 顯示全部帖子
回復 3# 准提部林


    謝謝前輩
後學藉此帖學習前輩的方案稍作變化,方案學習心得至解如下,請前輩再指導

資料表:


結果表執行前:


執行結果:



Option Explicit
Sub TEST()
Dim Arr, xD, i&, T1$, T2$, T3$
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑xD變數是 字典
Arr = Range([位置!A1], [位置!D65536].End(xlUp))
'↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
For i = 2 To UBound(Arr)
'↑設順迴圈
    T1 = Arr(i, 1): T2 = Arr(i, 4)
    '↑令迴圈Arr陣列值以變數承裝,順道定義其值是字串
    If T1 = "" Or T2 = "" Then GoTo i01
    '↑如果品號或 品名是空的,不執行!跳到 i01標示位置繼續執行
    T3 = T1 & "|" & T2:  xD(T3) = xD(T3) + 1
    '↑令T3是以"|"間隔的組合字串,
    '令T3變數當key,item是自身累加 1,納入xD字典
    If xD(T3) = 1 Then xD(T1) = Trim(xD(T1) & " " & T2)
    '↑如果T3變數是第1次納入字典(item值=1),
    '就令T1變數當key,item是自身值連接T2變數,中間以空白字元隔開,
    '最後再去除頭尾的空白字元
i01: Next i
Arr = Range([料件!A1], [料件!A65536].End(xlUp))
'↑令Arr變數是 二維陣列,以儲存格值帶入陣列中
For i = 2 To UBound(Arr)
'↑設順迴圈
    Arr(i - 1, 1) = Replace(xD(Arr(i, 1) & ""), " ", ",")
    '↑令以迴圈Arr陣列值查xD字典得到item值,經置換空白字元為逗號,
    '覆蓋掉原Arr陣列值
Next i
[料件!C2].Resize(UBound(Arr) - 1) = Arr
'↑令[料件!C2]擴展向下Arr陣列最大索引號-1個儲存格範圍值,
'以Arr陣列帶入,超過此範圍的陣列值被忽略
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 口說一句好話，如口出蓮花；口說一句壞話如口吐毒蛇。
返回列表 上一主題