返回列表 上一主題 發帖

[發問] 字串刪除重複

回復 1# qaqa3296

有空再看看 這樣可不可以
  1. Sub test1()
  2. Application.ScreenUpdating = False
  3.     [料件!C2:C6000].ClearContents '清除C資料
  4.     Set xD = CreateObject("Scripting.Dictionary") '字典
  5.     Sheets("料件").Select '跳到
  6.     arr = Range([位置!A2], [位置!D65536].End(xlUp))
  7.     Range(Sheets(2).Cells(2, 1).End(xlDown), Sheets(2).Cells(2, 4)).Sort Sheets(2).Cells(2, 4).End(xlDown)
  8.    
  9.     For I = 1 To UBound(arr)
  10.         If I = UBound(arr) Then Exit For
  11.         If arr(I, 4) <> arr(I + 1, 4) Then
  12.             xD(arr(I, 1)) = xD(arr(I, 1)) & "," & arr(I, 4)
  13.         End If
  14.     Next I
  15.    
  16.     Set xR = Range([A2], [A65536].End(xlUp))
  17.     For Each xT In xR
  18.         Cells(xT.Row, "C") = xD(xT.Value)
  19.     Next
  20.    
  21.     Set xD = Nothing
  22. Application.ScreenUpdating = True
  23. End Sub
複製代碼

TOP

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

TOP

        靜思自在 : 小事不做、大事難成。
返回列表 上一主題