Générer une liste de mots avec leur occurrence (plusieurs cellules)

Signaler
Messages postés
1
Date d'inscription
lundi 7 décembre 2020
Statut
Membre
Dernière intervention
7 décembre 2020
-
 Lena75 -
Bonjour à tous,

J'ai navigué dans plusieurs forum mais n'ai malheureusement pas trouvé réponse à ma problématique.
Je dispose d'un fichier excel avec plusieurs lignes et plusieurs colonnes remplis de texte et non pas de mot unique.
Je souhaiterais générer une liste avec tout les mots présents dans ces cellules y compris ceux présents dans les cellules contenant du texte avec leur nombre d'apparition dans tout le fichier excel.

Et si possible, créer une liste de mot à exclure (tel que les "le", "la", "et", etc.).

Avez-vous des solutions à me proposer ?

J'ai trouvé des bouts de VBA ne répondant que partiellement à ma problématique (prend en compte 1 seul cellule) mais je vous avoues ne pas bien maitriser la création de macro.

Merci d'avance pour votre retour.

2 réponses

Messages postés
12235
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
6 janvier 2021
2 550
Bonjour,

Un (gros) début de piste :
Option Explicit

Sub Vazy()
Dim Plage As Range, C As Range, arr, Dict As Object, strTexteComplet As String, temp As String
    Set Plage = Sheets("Feuil1").Range("A1:H23")  'A ADAPTER LA PLAGE CONTENANT LES DONNEES
    For Each C In Plage.Cells
        strTexteComplet = strTexteComplet & C.Text
    Next
    temp = RemovePunctuation(strTexteComplet)
    temp = UCase$(temp)
    arr = Split(temp, " ")
    Set Dict = CreateObject("Scripting.Dictionary")
    FillDictionary Dict, arr
    Erase arr
    SortDictByFreq Dict, arr
    DisplayTheTopMostUsedWords arr, 10
    Debug.Print "Mots différents dans la plage : " & Dict.Count
    Debug.Print "-------------------------"
    Debug.Print ""
    Debug.Print "Optionally : "
    Debug.Print "Fréquence du mot : ""contenu"" : " & DisplayFrequencyOf(UCase("contenu"), Dict)
    Debug.Print "Fréquence du mot : ""représente"" : " & DisplayFrequencyOf(UCase("représente"), Dict)
    Debug.Print "Fréquence du mot : ""tititototata"" : " & DisplayFrequencyOf(UCase("tititototata"), Dict)
    Debug.Print "-------------------------"
End Sub
Public Function RemovePunctuation(strBook As String) As String
Dim T, i As Integer, temp As String
Const PUNCT As String = """,;:!?."

   T = Split(StrConv(PUNCT, vbUnicode), Chr(0))
   temp = strBook
   For i = LBound(T) To UBound(T) - 1
      temp = Replace(temp, T(i), " ")
   Next
   temp = Replace(temp, "--", " ")
   temp = Replace(temp, "...", " ")
   temp = Replace(temp, vbCrLf, " ")
   RemovePunctuation = Replace(temp, "  ", " ")
End Function
Public Sub FillDictionary(D As Object, a As Variant)
Dim l As Long

   For l = LBound(a) To UBound(a)
      If a(l) <> "" Then D(a(l)) = D(a(l)) + 1
   Next
End Sub
Public Sub SortDictByFreq(D As Object, MyArr As Variant)
Dim k
Dim l As Long
   ReDim MyArr(1 To D.Count, 1 To 2)
   For Each k In D.Keys
      l = l + 1
      MyArr(l, 1) = k
      MyArr(l, 2) = CLng(D(k))
   Next
   SortArray MyArr, LBound(MyArr), UBound(MyArr), 2
End Sub
Public Sub SortArray(a, le As Long, Ri As Long, Col As Long)
Dim ref As Long, l As Long, r As Long, temp As Variant
   ref = a((le + Ri) \ 2, Col)
   l = le
   r = Ri
   Do
         Do While a(l, Col) < ref
            l = l + 1
         Loop
         Do While ref < a(r, Col)
            r = r - 1
         Loop
         If l <= r Then
            temp = a(l, 1)
            a(l, 1) = a(r, 1)
            a(r, 1) = temp
            temp = a(l, 2)
            a(l, 2) = a(r, 2)
            a(r, 2) = temp
            l = l + 1
            r = r - 1
         End If
   Loop While l <= r
   If l < Ri Then SortArray a, l, Ri, Col
   If le < r Then SortArray a, le, r, Col
End Sub
Public Sub DisplayTheTopMostUsedWords(arr As Variant, Nb As Long)
Dim l As Long, i As Integer
   i = 1
   Debug.Print "Rang Mot    Frequence"
   Debug.Print "==== ======= ========="
   For l = UBound(arr) To UBound(arr) - Nb + 1 Step -1
      Debug.Print Left$(CStr(i) & "    ", 5) & Left$(arr(l, 1) & "       ", 8) & " " & arr(l, 2)
      i = i + 1
   Next
End Sub
Public Function DisplayFrequencyOf(Word As String, D As Object) As Long
   If D.Exists(Word) Then DisplayFrequencyOf = D(Word)
End Function


Bon courage!
Bonjour,

Je cherchais à faire la même chose que toi et j'ai fini par me bricoler un code très archaïque (nécessite plusieurs feuillles...) comparé à ce qu'a proposé pijaku (que je remercie pour l'aide qu'il apporte depuis tout ce temps) mais qui fait le travail; est-ce que ça pourrait t'intéresser?

Cdlt