Fonction mots-clés avec mots à bannir Résolu/Fermé

Question

Bonjour, voila je m'explique.

J'ai une fonction qui me permet de lire une cellule puis de ressortir les mots les plus utiliser dans cette cellule et le nombre de fois ils ont été écris. Je voudrais y ajouter un bannissement de certain mots comme "et" "le" "la" ... 

Je vous mets le code :

Function mots(machaine As String)
   Dim Tableau() As String
    Dim i As Integer
    'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké  dans un tableau
    Tableau = Split(machaine, " ")
    max1 = 0
    max2 = 0
    max3 = 0
    max4 = 0
    max5 = 0
    max6 = 0
    max7 = 0
    max8 = 0
    max9 = 0
    max10 = 0
     'boucle sur le tableau
    For i = 0 To UBound(Tableau) - 1
    n = 1
    existe = 0
    ' boucle sur les items précédents du tableau
    For k = 0 To i - 1
    ' si le mot existe déjà (comparaison de mots en majuscules) existe passe à 1
    If UCase(Tableau(k)) = UCase(Tableau(i)) Then existe = 1
    Next k
    ' si existe=0 (pour en pas compter 2 fois un mot précédemment comptabilisé)
    If existe = 0 Then
    ' boucle sur les items suivants du tableau
    For j = i + 1 To UBound(Tableau) - 1
    ' si identique (comparaison majucules)alors incrémentation de n
    If UCase(Tableau(j)) = UCase(Tableau(i)) Then n = n + 1
    Next j
    ' si n> max 1, 2 ou 3 on remplace le max par n et on releve la valeur dans tableau
    If n > max1 Then max1 = n: mot1 = i Else: If n > max2 Then max2 = n: mot2 = i Else: If n > max3 Then max3 = n: mot3 = i Else: If n > max4 Then max4 = n: mot4 = i Else: If n > max5 Then max5 = n: mot5 = i Else: If n > max6 Then max6 = n: mot6 = i Else: If n > max7 Then max7 = n: mot7 = i Else: If n > max8 Then max8 = n: mot8 = i Else: If n > max9 Then max9 = n: mot9 = i Else: If n > max10 Then max10 = n: mot10 = i
    End If
    Next i
    ' nombre de fois et mots à retourner
    mots = max1 & " " & Tableau(mot1) & " " & max2 & " " & Tableau(mot2) & " " & max3 & " " & Tableau(mot3) & " " & max4 & " " & Tableau(mot4) & " " & max5 & " " & Tableau(mot5) & " " & max6 & " " & Tableau(mot6) & " " & max7 & " " & Tableau(mot7) & " " & max8 & " " & Tableau(mot8) & " " & max9 & " " & Tableau(mot9) & " " & max10 & " " & Tableau(mot10)
End Function

Merci d'avance.

via55 · Answer

Bonjour

Une possibiité :
1) Etablir en début de macro la liste des mots à bannir :
ban(1)="le"
ban(2)="la"
etc

2) dans la boucle sur les items du tableau pour voir si existe déjà avant le next k rajouter ces lignes
For t=1 to (mettre ici le nombre n  maximum de ban(n))
If UCase(Tableau(k))=UCase(ban(t)) then existe =1
Next t

Cdlmnt
Via

michel_m · Answer

Bonjour,

Une autre manière (je n'ai pas vérifié la sensibilité à la casse)
http://www.cjoint.com/c/EHrnqKD5Vlo
 code proposé par macro paramétrée 
Option Explicit'---------------------------Sub analyser()    selectionner range("B3"), range("B4")End SubSub selectionner(texto, Bannis As range)Dim MotsDim D_mots As Object, Cptr As Integer    Mots = Split(texto)    Set D_mots = CreateObject("scripting.dictionary")        For Cptr = 0 To UBound(Mots) - 1        If Application.CountIf(Bannis, "*" & Mots(Cptr) & "*") = 0 Then            If Not D_mots.exists(Mots(Cptr)) Then                D_mots.Add Mots(Cptr), 1            Else                D_mots(Mots(Cptr)) = D_mots(Mots(Cptr)) + 1            End If        End If    Next    range("E5").Resize(D_mots.Count, 1) = Application.Transpose(D_mots.keys)    range("F5").Resize(D_mots.Count, 1) = Application.Transpose(D_mots.items)End Sub

Fonction mots-clés avec mots à bannir

2 réponses

Discussions similaires