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