我在每個單元格上都有重復的行，這些行只是由 vbLf 分隔的 URL 地址。
我需要洗掉duplicate lines，但僅限于列上的每個單元格。
我找到了下面的函式，但它只洗掉每個單元格的單詞。
提前感謝任何有用的評論和答案。
Function RemoveDupeWords(text As String, Optional delimiter As String = " ") As String
Dim dictionary As Object
Dim x, part
Set dictionary = CreateObject("Scripting.Dictionary")
dictionary.CompareMode = vbTextCompare
For Each x In Split(text, delimiter)
part = Trim(x)
If part <> "" And Not dictionary.Exists(part) Then
dictionary.Add part, Nothing
End If
Next
If dictionary.Count > 0 Then
RemoveDupeWords = Join(dictionary.keys, delimiter)
Else
RemoveDupeWords = ""
End If
Set dictionary = Nothing
End Function
uj5u.com熱心網友回復：
如果您有 Windows Excel 2019 ，則可以使用公式執行此操作：
=TEXTJOIN(CHAR(10),,FILTERXML("<t><s>"& SUBSTITUTE(A2,CHAR(10),"</s><s>")& "</s></t>","//s[not (preceding::*=.)]"))
另外，如果你有最新的 Office 365 Insiders 版本，你可以FILTERXML用新TEXTSPLIT功能替換。
uj5u.com熱心網友回復：
也許這會成功
sub RemoveDupeLine()
Dim coll As Collection
Dim i As Long, c, txt As String, arr As Variant
Dim rng As Range: Set rng = ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion
For Each c In rng
Set coll = New Collection
arr = Split(c.Value, vbLf)
For i = LBound(arr) To UBound(arr)
' Here's the trick. For a collection in this insert mode it cannot accept duplicate key entries. And in that I instruct him to ignore the error, he accumulates only unique values and move on.
On Error Resume Next
coll.Add Item:=arr(i), Key:=arr(i)
On Error GoTo 0
Next i
If coll.Count > 0 Then
For i = 1 To coll.Count
txt = txt & coll(i) & vbLf
Next i
End If
c.Value = txt
txt = ""
Set coll = Nothing
Next
End sub
祝你好運
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/470581.html