字串刪除重複 - Excel程式區 - 麻辣家族討論版版

[發問] 字串刪除重複

1^# 跳轉到 »

發表於 2020-10-11 01:21 | 顯示全部帖子

回復 1# qaqa3296

有空再看看這樣可不可以

Sub test1()
Application.ScreenUpdating = False
[料件!C2:C6000].ClearContents '清除C資料
Set xD = CreateObject("Scripting.Dictionary") '字典
Sheets("料件").Select '跳到
arr = Range([位置!A2], [位置!D65536].End(xlUp))
Range(Sheets(2).Cells(2, 1).End(xlDown), Sheets(2).Cells(2, 4)).Sort Sheets(2).Cells(2, 4).End(xlDown)
For I = 1 To UBound(arr)
If I = UBound(arr) Then Exit For
If arr(I, 4) <> arr(I + 1, 4) Then
xD(arr(I, 1)) = xD(arr(I, 1)) & "," & arr(I, 4)
End If
Next I
Set xR = Range([A2], [A65536].End(xlUp))
For Each xT In xR
Cells(xT.Row, "C") = xD(xT.Value)
Next
Set xD = Nothing
Application.ScreenUpdating = True
End Sub

複製代碼

2^#

發表於 2020-10-11 11:08 | 顯示全部帖子

謝謝准提大大和 hcm19522 大大的指導
用 .Sort 會出現奇怪的問題要點2次執行才會正常不知道為甚麼

靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。