删除包含多行文本的单元格中重复文本的VBA自定义函数

Public Function fnUnique(rng As Range)
 Dim dict As Object
 Dim dOut As Object
 Dim val As Variant
 Dim var As Variant
 Dim i As Integer
 Dim sKey As String
 
 Set dict = CreateObject("scripting.dictionary")
 Set dOut = CreateObject("scripting.dictionary")
 
 dict.CompareMode = vbTextCompare
 dOut.CompareMode = vbTextCompare
 
 val = rng.Value & ""
 var = Split(val, Chr(10))
 
 On Error Resume Next
 
 For i = 0 To UBound(var)
   sKey = Split(var(i))(0)
   If dict.exists(sKey) = False Then
     dict.Add Key:=sKey, Item:=var(i)
   Else
     dOut.Add Key:=var(i), Item:=var(i)
   End If
 Next
 
 For i = 1 To dOut.Count
   val = Replace$(val, dOut.items()(i - 1), "")
 Next
 
 If Right$(val, 1) = Chr(10) Then
   val = Left$(val, Len(val) - 1)
 End If
 
 fnUnique = val
 
 Set dict = Nothing
 Set dOut = Nothing
End Function