Function OccurrenceMot3(Chaine As String, occurrence As Double) As String
Dim s As Variant, T(), T2(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Byte, Borne As Byte
Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Global = True
.MultiLine = True
'traitement des espaces
.Pattern = "\s+"
If .Test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
'traitement des caractères ponctuation
.Pattern = "[,?!;.:…_()\[\]{}“”«»\\|/§~#`^@]+" ' '’-–—
If .Test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
'traitement des apostrophes
.Pattern = "(^|\s)(c|d|l|n|qu|s)(’|')"
If .Test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
'épurage des espaces en trop "
.Pattern = "(\s){2,}"
If .Test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
End With
Set dico = CreateObject("scripting.dictionary")
s = Split(Trim(Chaine))
For i = LBound(s) To UBound(s)
If Application.CountIf([Mots], s(i)) = 0 Then
dico(s(i)) = dico(s(i)) + 1
End If
Next i
T = dico.keys
T2 = dico.items
Borne = Application.Min(dico.Count, occurrence)
ReDim TOc(1 To Borne)
For i = 1 To Borne
k = Application.Match(Application.Max(T2), T2, 0) - 1
TOc(i) = T(k): T2(k) = ""
Next i
OccurrenceMot3 = Join(TOc, vbLf)
End Function