Doublons dans meme cellule

Function SansDoublons%(txt$)
Dim d As Object, n%, i%, s$
txt = Application.Trim(txt)
Set d = CreateObject("Scripting.Dictionary")
n = Len(txt) - Len(Replace(txt, " ", ""))
For i = 0 To n
s = Split(txt, " ")(i)
If Not d.Exists(s) Then d.Add s, s
Next
SansDoublons = d.Count
End Function

Function EnlèveDoublons$(txt$)
Dim d As Object, n%, i%, s$
txt = Application.Trim(txt)
Set d = CreateObject("Scripting.Dictionary")
n = Len(txt) - Len(Replace(txt, " ", ""))
For i = n To 0 Step -1
s = Split(txt, " ")(i)
If d.Exists(s) Then txt = Application.Substitute(txt, s, "", 2) Else d.Add s, s
Next
EnlèveDoublons = Application.Trim(txt)
End Function

Function SansDoublon(c)
  a = Split(Application.Trim(c), " ")
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = 0 To UBound(a): mondico.Item(a(i)) = 1: Next i
  SansDoublon = Join(mondico.keys, " ")
End Function

Sub supDoubles()
 derLig = 11
 '-- sup des cellules contenant des doublons à l'intérieur
 For Each c In Cells(2, 1).Resize(derLig)
   If EstDoublon(c) Then c.ClearContents
 Next
 '-- suppression des doublons entre cellules dans un ordre différent
 Set mondico1 = CreateObject("Scripting.Dictionary")
 Set mondico2 = CreateObject("Scripting.Dictionary")
 For i = 2 To derLig
   If Cells(i, 1) <> "" Then
    temp = TriCell(Cells(i, 1))
    If Not mondico1.exists(temp) Then
      mondico1.Add temp, temp
      mondico2.Add Cells(i, 1), 1
    Else
      Cells(i, 1).ClearContents
    End If
   End If
 Next i
 [C2].Resize(mondico2.Count) = Application.Transpose(mondico2.keys)
End Sub

Cellule 1             cellule 2              Cellule 3
14h00-16h00         18h00-21h00          XXhXX-XXhXX

Function EnlèveDoublons$(txt$, n%)
Dim s, u%, i%, test1 As Boolean, test2 As Boolean
txt = Application.Trim(txt)
s = Split(txt)
u = UBound(s)
For i = 0 To u
  If i = 0 Then test1 = True Else test1 = s(i) <> s(i - 1)
  If i = u Then test2 = True Else test2 = s(i) <> s(i + 1)
  If test1 And test2 Then EnlèveDoublons = EnlèveDoublons & " " & s(i)
Next
s = Split(Trim(EnlèveDoublons))
If 2 * n - 1 > UBound(s) Then EnlèveDoublons = "": Exit Function
EnlèveDoublons = s(2 * n - 2) & "-" & s(2 * n - 1)
End Function