recherche de doublons

Function Proche(DemClient, cata As Range)
  Set dMotsCat = CreateObject("Scripting.Dictionary")
  Set dref = CreateObject("Scripting.Dictionary")
  i = 1
  For Each c In cata
    dref(CStr(i)) = c.Value
    For Each m In Split(Trim(c.Value), " ")
      dMotsCat(sansAccent(LCase(m))) = dMotsCat(sansAccent(LCase(m))) & CStr(i) & " "
    Next m
    i = i + 1
  Next c
  DemClient = sansAccent(SansPoint(LCase(DemClient)))
  Set dDemClient = CreateObject("Scripting.Dictionary")
  For Each m In Split(DemClient, " ")
    tem = False
    For Each i In dMotsCat.keys
      If i Like m & "*" Then
        tem = True
        Exit For
      End If
    Next i
     If tem Then
      For Each ref In Split(Trim(dMotsCat(i)), " ")
        dDemClient(ref) = dDemClient(ref) + 1
      Next ref
    End If
  Next m
  '-- recherche maxi dans dDemClient
  If dDemClient.Count > 0 Then
   Maxi = Application.Max(dDemClient.items)
   MeilNotePourc = 0
   For Each ref In dDemClient.keys
     If dDemClient(ref) = Maxi Then
        notePourc = Maxi / (UBound(Split(dref(ref), " ")) + 1)
        If notePourc > MeilNotePourc Then
           MeilNotePourc = notePourc
           RefMeilNote = ref
           meilNote = Maxi & "/" & (UBound(Split(Trim(dref(ref)), " ")) + 1)
        End If
     End If
   Next ref
   Proche = dref(RefMeilNote) '& " [" & meilNote & "]"
  Else
   Proche = ""
  End If
End Function

Function SansPoint(chaine)
  a = Split(chaine, " ")
  For i = LBound(a) To UBound(a)
    If Right(a(i), 1) = "." Then a(i) = Left(a(i), Len(a(i)) - 1)
  Next i
  SansPoint = Join(a, " ")
End Function

Function sansAccent(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function