Compter le nombre de fois ou apparaît un mot

[Vilain]

Salut à tous,

Je fais appel aux formulistes ! J'ai une demande un peu particulière. J'ai un fichier excel ne comportant quasiment que du texte.
Je cherche à identifier les 20 mots qui ressortent le plus souvent dans l'ensemble du document d'une part et au sein d'une seule cellule d'autre part.

Je joins un fichier pour les tests.

A plus

 

[david84]

Re : Compter le nombre de fois ou apparaît un mot

Bonjour,
ci-joint une fonction permettant d'obtenir tous les mots et leur fréquences d'apparition (testé sur le fichier de Gérard que je salue) :

Function FrequenceMotMat(Plage As Range)
Dim s As Variant, T(), T2(), TOc(), oRegExp As Object
Dim i As Long, k As Long, dico As Object, Chaine As String, Pl As Range

Set Pl = Plage
For i = 1 To Pl.Rows.Count
    Chaine = Chaine & Pl(i) & " "
Next i

Chaine = Application.Trim(LCase(Replace(Chaine, """", "")))

Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
  .Global = True
  .MultiLine = True
  .ignorecase = True
    'traitement des caractères ponctuation
    .Pattern = "[,?!;.:…_()\[\]{}“”«»\\|/§~#`^@]+" ' '’-–—
    If .test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
      
    'traitement des apostrophes
    .Pattern = "(’|')"
    If .test(Chaine) = True Then Chaine = .Replace(Chaine, "$1 ")
    Chaine = Application.Trim(Chaine)
End With

Set dico = CreateObject("scripting.dictionary")
s = Split(Chaine)
For i = LBound(s) To UBound(s)
    dico(s(i)) = dico(s(i)) + 1
Next i
T = dico.keys
T2 = dico.items
ReDim TOc(1 To Application.Caller.Rows.Count)
For i = 1 To dico.Count
    k = Application.Match(Application.Max(T2), T2, 0) - 1
    TOc(i) = T(k) & " (" & T2(k) & ")": T2(k) = ""
Next i
FrequenceMotMat = Application.Transpose(TOc)
End Function

@Gérard : nos résultats semblent concorder (cf.formule en colonne I permettant de comparer nos résultats), mis à part "servitude" car ton code ramène "servitude;" avec le ";" accolé.
A+

 

[job75]

Re : Compter le nombre de fois ou apparaît un mot

Re David,

Normalement le point-virgule doit être entre deux espaces, mais s'il faut le séparer :

s = Replace(Replace(Replace(Replace(s, ",", " , "), ".", " . "), ";", " ; "), "'", "' ")

Fichier (3).

A+

 

[david84]

Re : Compter le nombre de fois ou apparaît un mot

Re

Normalement le point-virgule doit être entre deux espaces

D'accord avec toi sur le principe mais c'était juste pour te le signaler.

Sinon, si l'on veut également comptabiliser les signes de ponctuation, il faut à peine retoucher le motif gérant les ponctuations afin de les prendre en compte et non les exclure :

Function FrequenceMotMat2(Plage As Range)
Dim s As Variant, T(), T2(), TOc(), oRegExp As Object
Dim i As Long, k As Long, dico As Object, Chaine As String, Pl As Range

Set Pl = Plage
For i = 1 To Pl.Rows.Count
    Chaine = Chaine & Pl(i) & " "
Next i

Chaine = Application.Trim(LCase(Replace(Chaine, """", "")))

Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
  .Global = True
  .MultiLine = True
  .ignorecase = True
    'traitement des caractères ponctuation
    .Pattern = "([,?!;.:…_()\[\]{}“”«»\\|/§~#`^@])" ' '’-–—
    If .test(Chaine) = True Then Chaine = .Replace(Chaine, " $1 ")
    
    'traitement des apostrophes
    .Pattern = "(’|')"
    If .test(Chaine) = True Then Chaine = .Replace(Chaine, "$1 ")
    Chaine = Application.Trim(Chaine)
End With

Set dico = CreateObject("scripting.dictionary")
s = Split(Chaine)
For i = LBound(s) To UBound(s)
    dico(s(i)) = dico(s(i)) + 1
Next i
T = dico.keys
T2 = dico.items
ReDim TOc(1 To Application.Caller.Rows.Count)
For i = 1 To dico.Count
    k = Application.Match(Application.Max(T2), T2, 0) - 1
    TOc(i) = T(k) & " (" & T2(k) & ")": T2(k) = ""
Next i
FrequenceMotMat2 = Application.Transpose(TOc)
End Function

A+

 

[job75]

Re : Compter le nombre de fois ou apparaît un mot

Re,

Cette version (4) est plus rapide.

En effet le comptage est effectué par l'objet Dictionary (comme le fait David) :

Sub CompterMots()
Dim t, s, i&, d As Object, t1(1000000, 1)
t = Feuil1.Range("A1", Feuil1.Cells(Rows.Count, 1).End(xlUp)) 'CodeName
ReDim s(UBound(t) - 1)
For i = 0 To UBound(s)
  s(i) = t(i + 1, 1)
Next
s = Join(s)
s = Replace(Replace(Replace(Replace(s, ",", " , "), ".", " . "), ";", " ; "), "'", "' ")
s = Application.Trim(s) 'SUPPRESPACE
s = Split(s)
Set d = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(s)
  t = LCase(s(i))
  d(t) = d(t) + 1
Next
t = d.keys
s = d.items
For i = 0 To UBound(t)
  t1(i, 0) = t(i)
  t1(i, 1) = s(i)
Next
Application.ScreenUpdating = False
With Feuil2 'CodeName
  .Range("A2:B" & Rows.Count).ClearContents 'RAZ
  .[A2:B2].Resize(d.Count) = t1
  .[A2:B2].Resize(d.Count).Sort .[B2], xlDescending, .[A2], Header:=xlNo 'tri
  .Activate
End With
End Sub

Option Compare Text n'est plus nécessaire.

A+

 

[david84]

Re : Compter le nombre de fois ou apparaît un mot

Re

Si l'on veut comptabiliser les signes de ponctuation, il faut alors également prévoir les guillemets (ma version précédente effaçait le caractère 34) : voilà qui est fait.

Function FrequenceMotMat2(Plage As Range)
Dim s As Variant, T(), T2(), TOc(), oRegExp As Object
Dim i As Long, k As Long, dico As Object, Chaine As String, Pl As Range

Set Pl = Plage
For i = 1 To Pl.Rows.Count
    Chaine = Chaine & Pl(i) & " "
Next i

Chaine = Application.Trim(LCase(Chaine))

Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
  .Global = True
  .MultiLine = True
  .ignorecase = True
    'traitement des caractères ponctuation
    .Pattern = "([,?!;.:…_()\[\]{}“”«»\\|/§~#`^@""""])" ' '’-–—
    If .test(Chaine) = True Then Chaine = .Replace(Chaine, " $1 ")
    
    'traitement des apostrophes
    .Pattern = "(’|')"
    If .test(Chaine) = True Then Chaine = .Replace(Chaine, "$1 ")
    Chaine = Application.Trim(Chaine)
End With

Set dico = CreateObject("scripting.dictionary")
s = Split(Chaine)
For i = LBound(s) To UBound(s)
    dico(s(i)) = dico(s(i)) + 1
Next i
T = dico.keys
T2 = dico.items
ReDim TOc(1 To Application.Caller.Rows.Count)
For i = 1 To dico.Count
    k = Application.Match(Application.Max(T2), T2, 0) - 1
    TOc(i) = T(k) & " (" & T2(k) & ")": T2(k) = ""
Next i
FrequenceMotMat2 = Application.Transpose(TOc)
End Function

A+