删除重复行，仅针对列中的每个单元格

Question

我在每个单元格上都有重复的行，这些行只是 URL 地址，由 vbLf 分隔。
我需要删除 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

Answer 1

也许这样就可以了

    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

祝你好运

Answer 2

如果您有 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 功能。

删除重复行，仅针对列中的每个单元格

Remove duplicate lines, only per each cell on a column

excel

vba