comptage de mots clé...

Sn4ke

XLDnaute Nouveau
Bonjour,
J'aurais donc besoin de votre précieuse aide pour la rédaction d'une macro.
Ca m'as l'air compliqué à moi même, donc je ne sais pas si c'est faisable d'une part et ensuite sans que ca demande trop de temps...
Donc pour ma demande, je voudrais en fait sur la base de mon document joint Compter le nombre d’occurrences de chaque mots pour les textes des colonnes "Content text" en excluant les mots présents dans l'onglet liste. A partir de ça je voudrais ajouter ces mots clés aux mots deja présents dans la colonne Tags en gardant les séparations par le ";" ...

Je suis preneur bien évidemment de toutes vos solutions.

Merci beaucoup, et n'hésitez pas si je n'ai malheureusement pas été assez clair...
 

Pièces jointes

  • sn4ke.xlsx
    12.8 KB · Affichages: 59

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Bonjour, et merci beaucoup David.
J'ai donc pioché dans ces sources, ce qui me donne le document en pj.
Comment indiquer dans les parenthèse le pourcentage de présence par rapport au nombre de mots présent dans l'article?
J'aurais ensuite besoin d'jouter ces mots a la liste présente dans la colonne Tags.
Merci de votre aide.
 

Pièces jointes

  • sn4ke_V2.xlsm
    26 KB · Affichages: 44
  • sn4ke_V2.xlsm
    26 KB · Affichages: 53
  • sn4ke_V2.xlsm
    26 KB · Affichages: 52

david84

XLDnaute Barbatruc
Re : comptage de mots clé...

Re
Je crois que l'on ne s'est pas bien compris : j'ai dis que tu pouvais t'inspirer de ce fil, non que la solution proposée te conviendrait telle quelle...je veux bien t'aider mais j'ai l'impression que je suis parti pour tout te faire et ce n'est pas le but de ce forum.
Ceci dit, il est vrai que les expressions rationnelles ne sont pas évidentes à manipuler mais il faut y mettre du tien quand même.
Commence par reprendre ton fichier en prenant un exemple de texte et en notant manuellement à la main le résultat attendu pour que je comprenne ce que tu veux.
Et surtout choisis un exemple explicite afin que toutes les contraintes soient intégrées dès le départ.
A+
 

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Re David,

Tout d'abord je m'excuse du "ton employé" dans mon post, le but n'est pas du tout de faire faire le travail dans sa totalité. Mais étant donné que je n'ai quasiment aucune connaissance en Vb hormis des une connaissance d'autre langages et en algo, je cherche donc des solutions où je peux en trouver. Pour ce qui est des contraintes de ma demandes, les voici.

J'ai donc dans la colonne Content Text 100 mots:
- 13 Occurences de Tata
- 11 de Tete
- 7 de Titi
- 5 de Toto
- 5 de Tutu
- 5 de Tyty
- 4 de Zozo
- 4 de Zizi
- 4 de Zaza
+ 48 autres mots n'ayant qu'une occurence chacun.

Je souhaiterais afficher dans la colonne Key words les 5 mots les plus répetés avec entre parenthèse leurs pourcentages. Les mots présents dans l'onglet liste ne doivent pas y figurer. S'il y a des mots ayant un poucentage superieur à 7 ils ne devront pas apparaitre et la valeur "1" doit être affectée à la colonne Spam.
Ce qui donneras :
Titi (7)
Tyty (5)
Zozo (4)
Zizi (5)
Zaza (4)

Je voudrais pour finir ajouter ces mots clés à la colonne Tags qui devra au final ressembler à :
FirstTag;SecondTag;Titi;Toto;Tutu;Tyty;Zozo

L'exemple se trouve en pièces jointes.

Encore une fois j'imagine la charge de travail que ça représente, et merci d'avance pour les futures solutions/orientations apportées.

Merci :)
 

Pièces jointes

  • sn4ke_V2.xlsm
    22.8 KB · Affichages: 52
  • sn4ke_V2.xlsm
    22.8 KB · Affichages: 56
  • sn4ke_V2.xlsm
    22.8 KB · Affichages: 58
Dernière édition:

david84

XLDnaute Barbatruc
Re : comptage de mots clé...

Re

Tout d'abord je m'excuse du "ton employé" dans mon post, le but n'est pas du tout de faire faire le travail dans sa totalité. Mais étant donné que je n'ai quasiment aucune connaissance en Vb hormis des une connaissance d'autre langages et en algo, je cherche donc des solutions où je peux en trouver.
Le ton employé est tout à fait correct. Nous allons tenter de t'aider mais à toi d'être précis de manière à nous permettre de comprendre ton attente et de ne pas reprendre ce que nous te proposons. Or en comparant tes différents fichiers, j'ai justement l'impression que tu ne nous donnes pas toutes les clés. Donc, dans le doute, je te joins une fonction à tester dans laquelle il y a pour l'instant différentes parties qui ne servent pas au problème tel que tu nous le présente, mais je les laisse au cas où...

Code:
Function OccurrenceMot(Chaine As String, occurrence As Integer, Optional Seuil As Integer = 100) As String
Dim s As Variant, T(), T2(), T3(), T4(), T5(), T6(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Byte, Borne As Byte, l As Integer
'Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With Sheets("liste")
    Set Liste = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    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(Liste, s(i)) = 0 Then
        dico(s(i)) = dico(s(i)) + 1
    End If
Next i
T = dico.keys
T2 = dico.items
For i = LBound(T2) To UBound(T2)
 If T2(i) <= Seuil Then
    ReDim Preserve T3(LBound(T2) To k)
    ReDim Preserve T4(LBound(T2) To k)
    T3(k) = T(i)
    T4(k) = T2(i)
    k = k + 1
 Else
    ReDim Preserve T5(LBound(T2) To l)
    ReDim Preserve T6(LBound(T2) To l)
    T5(l) = T(i)
    T6(l) = T2(i)
    l = l + 1
 End If
Next i
Borne = Application.Min(dico.Count, occurrence)
ReDim TOc(1 To Borne)
For i = 1 To Borne
    k = Application.Match(Application.Max(T4), T4, 0) - 1
    TOc(i) = T3(k) & " (" & T4(k) & ")": T4(k) = ""
Next i
OccurrenceMot = Join(TOc, vbLf)
End Function
La fonction comprend 2 arguments obligatoires :
- la cellule comportant la chaîne de caractères à traiter ;
- le nombre de mots à ramener
et un argument optionnel : le nombre d'occurrence maximum qui doit être pris en compte.

Je souhaiterais afficher dans la colonne Key words les 5 mots les plus répetés avec entre parenthèse leurs pourcentages
Tu parles de pourcentage mais ton exemple évoque plutôt un dénombrement : c'est donc ce que j'ai traité pour l'instant.

S'il y a des mots ayant un poucentage superieur à 7 ils ne devront pas apparaitre et la valeur "1" doit être affectée à la colonne Spam.
Pour l'instant, cela n'est pas traité (on verra après) mais précise ta pensée STP.

Je voudrais pour finir ajouter ces mots clés à la colonne Tags qui devra au final ressembler à :
FirstTag;SecondTag;Titi;Toto;Tutu;Tyty;Zozo
En fait, tu veux dans cette colonne les mêmes mots que ceux ramenés par la fonction ? Quel en est l'intérêt ?

Pour l'instant, concentrons-nous sur le code fourni : te convient-il ? Si non, à toi de préciser ce qui ne va pas.
A+
 

Pièces jointes

  • sn4ke_V2(4).xlsm
    23.4 KB · Affichages: 56
  • sn4ke_V2(4).xlsm
    23.4 KB · Affichages: 55
  • sn4ke_V2(4).xlsm
    23.4 KB · Affichages: 49

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Bonjour David,

Merci de ton aide!

Alors,
Tu parles de pourcentage mais ton exemple évoque plutôt un dénombrement

Non, c'est bien un pourcentage, il correspond en effet aux dénombrement car le nombre de mots est égal à 100, mais dans d'autres exemples il devras afficher le pourcentage..



La fonction comprend 2 arguments obligatoires :
- la cellule comportant la chaîne de caractères à traiter ;
- le nombre de mots à ramener
et un argument optionnel : le nombre d'occurrence maximum qui doit être pris en compte.

La fonction est parfaite, mais étant donné le point précedent, l'argument optionnel doit être le pourcentage de présence maximum du mot dans le texte.



S'il y a des mots ayant un poucentage superieur à 7 ils ne devront pas apparaitre et la valeur "1" doit être affectée à la colonne Spam.
Pour l'instant, cela n'est pas traité (on verra après) mais précise ta pensée STP.

En gros, la cellule SPAM devras afficher 1 si le pourcentage d'un mot dépasse l'argument "seuil".



En fait, tu veux dans cette colonne les mêmes mots que ceux ramenés par la fonction ? Quel en est l'intérêt ?

Oui, je veux dans cette colonne les mots ramenés dans cette fonction + ceux qui y sont déjà présents. L’intérêt réside dans la finalité de ce travail, un extract sera ensuite fait sur cette cellule, mais ça je ne m'en occupe pas...

Merci encore!!
 

david84

XLDnaute Barbatruc
Re : comptage de mots clé...

Bonsoir,
concernant la fonction et suite à tes remarques, essaie cette nouvelle version :
Code:
Function OccurrenceMot(Chaine As String, occurrence As Integer, Optional Seuil As Integer = 100) As String
Dim s As Variant, T(), T2(), T3(), T4(), T5(), T6(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Byte, Borne As Byte, l As Integer
'Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With Sheets("liste")
    Set Liste = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    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(Liste, s(i)) = 0 Then
        dico(s(i)) = dico(s(i)) + 1
    End If
Next i
T = dico.keys
T2 = dico.items

For i = LBound(T2) To UBound(T2)
 If T2(i) <= Seuil Then
    ReDim Preserve T3(LBound(T2) To k)
    ReDim Preserve T4(LBound(T2) To k)
    T3(k) = T(i)
    T4(k) = T2(i)
    k = k + 1
 Else
    ReDim Preserve T5(LBound(T2) To l)
    ReDim Preserve T6(LBound(T2) To l)
    T5(l) = T(i)
    T6(l) = T2(i)
    l = l + 1
 End If
Next i
Borne = Application.Min(dico.Count, occurrence)
ReDim TOc(1 To Borne)
For i = 1 To Borne
    k = Application.Match(Application.Max(T4), T4, 0) - 1
    TOc(i) = T3(k) & " (" & Format(T4(k) / (UBound(s) + 1), "0%") & ")": T4(k) = ""
Next i
OccurrenceMot = Join(TOc, vbLf)
End Function
En gros, la cellule SPAM devras afficher 1 si le pourcentage d'un mot dépasse l'argument "seuil".
Ok
Oui, je veux dans cette colonne les mots ramenés dans cette fonction + ceux qui y sont déjà présents.
je crois que j'ai compris le principe mais je préfère que tu me prennes un exemple concret et que tu me note manuellement les résultats attendus sur le fichier.

Plus généralement, les 3 points que tu demandes (Key words, spam et Tags) peuvent être solutionnés de 2 manières ;
- 3 fonctions distinctes
- une sub traitant le tout.
As-tu une préférence ?
A+
 

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Re David,

Concernant la cellule Tags, l'exemple est déjà présent dans la feuille. Je voudrais qu'avec cet exemple il soit inscrit dans la cellule Tags : FirstTag;SecondTag;Titi;Toto;Tutu;Tyty;Zozo .
Pour le reste c'est exactement ce que je souhaitais, Merci :)
 

david84

XLDnaute Barbatruc
Re : comptage de mots clé...

Bonjour,
Bon, pas sûr d'avoir tout compris mais histoire de te permettre de tester, ci-joint 3 fonctions adaptées vite fait et brutes de décoffrage avant que je ne parte pour la journée :
Fonction Key_Word (remplace la fonction Occurrence_mots) :
Code:
Function Key_word(Chaine As String, occurrence As Integer, Optional Seuil As Integer = 100) As String
Dim s As Variant, T(), T2(), T3(), T4(), T5(), T6(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Byte, Borne As Byte, l As Integer
'Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With Sheets("liste")
    Set Liste = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    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(Liste, s(i)) = 0 Then
        dico(s(i)) = dico(s(i)) + 1
    End If
Next i
T = dico.keys
T2 = dico.items

For i = LBound(T2) To UBound(T2)
 If T2(i) <= Seuil Then
    ReDim Preserve T3(LBound(T2) To k)
    ReDim Preserve T4(LBound(T2) To k)
    T3(k) = T(i)
    T4(k) = T2(i)
    k = k + 1
 Else
    ReDim Preserve T5(LBound(T2) To l)
    ReDim Preserve T6(LBound(T2) To l)
    T5(l) = T(i)
    T6(l) = T2(i)
    l = l + 1
 End If
Next i
Borne = Application.Min(dico.Count, occurrence)
ReDim TOc(1 To Borne)
For i = 1 To Borne
    k = Application.Match(Application.Max(T4), T4, 0) - 1
    TOc(i) = T3(k) & " (" & Format(T4(k) / (UBound(s) + 1), "0%") & ")": T4(k) = ""
Next i
Key_word = Join(TOc, vbLf)
End Function

Fonction Tags :
Code:
Function Tags(Chaine As String) As String
Dim s As Variant, oRegExp As Object, Matches As Object
'Application.Volatile
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    If .Test(Chaine) = True Then Chaine = .Replace(Chaine, "")
    
    .Pattern = "(\(\d+%\))+"
    If .Test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
End With
s = Split(Trim(Chaine))
Tags = "FirstTag;SecondTag;" & Join(s, ";")
End Function

Fonction Spam
Code:
Function Spam(Chaine As String, occurrence As Integer, Optional Seuil As Integer = 100) As String
Dim s As Variant, T(), T2(), T3(), T4(), T5(), T6(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Byte, Borne As Byte, l As Integer
'Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With Sheets("liste")
    Set Liste = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    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(Liste, s(i)) = 0 Then
        dico(s(i)) = dico(s(i)) + 1
    End If
Next i
T = dico.keys
T2 = dico.items

For i = LBound(T2) To UBound(T2)
 If T2(i) <= Seuil Then
    ReDim Preserve T3(LBound(T2) To k)
    ReDim Preserve T4(LBound(T2) To k)
    T3(k) = T(i)
    T4(k) = T2(i)
    k = k + 1
 Else
    ReDim Preserve T5(LBound(T2) To l)
    ReDim Preserve T6(LBound(T2) To l)
    T5(l) = T(i)
    T6(l) = T2(i)
    l = l + 1
 End If
Next i
If l > 0 Then Spam = 1
End Function
On peut simplifier certaines parties des fonction mais teste d'abord, on verra ensuite.
Teste le fichier en y plaçant au besoin de nouveau exemples pour l'étoffer et les tester et note manuellement sur ce même fichier les résultats attendus si ces derniers ne correspondent pas à ton attente.
A+
 

Pièces jointes

  • sn4ke_V2(4).xlsm
    26.2 KB · Affichages: 50
  • sn4ke_V2(4).xlsm
    26.2 KB · Affichages: 55
  • sn4ke_V2(4).xlsm
    26.2 KB · Affichages: 59
Dernière édition:

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Bonjour,
pour les fonction Key_word et Spam, tout me vas, mis à part le fait que l'argument facultatif seuil représente un nombre d'occurence, et j'aimerais filtrer par rapport au pourcentage de présence dans le texte.
Ensuite pour la fonction Tag le seul "problème" est qu'elle ne prend pas en compte les mots que contient à l'origine les cellules Tags et les insère en brut.
J'ai mis une sorte d'exemple dans le document joint.

Merci encore!!
 

Pièces jointes

  • sn4ke_V3.xlsm
    26.8 KB · Affichages: 55
  • sn4ke_V3.xlsm
    26.8 KB · Affichages: 56
  • sn4ke_V3.xlsm
    26.8 KB · Affichages: 48
Dernière édition:

david84

XLDnaute Barbatruc
Re : comptage de mots clé...

Bonsoir,
Franchement, avec 2 exemples basique, pas évident de te comprendre...si je ne me trompe pas, il suffit d'ajouter dans la fonction Tag un argument supplémentaire optionnel, à savoir la cellule du Tag du dessus :
Code:
Function Tags(Chaine As String, Optional Plage As Range) As String
Dim s As Variant, oRegExp As Object, Matches As Object
'Application.Volatile
s = Split(Trim(Chaine))
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    If .Test(Chaine) = True Then Chaine = .Replace(Chaine, "")
    
    .Pattern = "(\(\d+%\))+"
    If .Test(Chaine) = True Then Chaine = .Replace(Chaine, " ")
End With
s = Split(Trim(Chaine))
If Plage Is Nothing Then Tags = Join(s, ";") Else Tags = Plage & ";" & Join(s, ";")
End Function
Ceci dit, tes explications ne permettent pas de comprendre si les valeurs qui se répètent doivent apparaître plusieurs fois ou non.
Si c'est la cas, la fonction le permet. Dans le cas contraire, il faudra intégrer un dictionnaire.
A+

Edit :
Concernant l'argument optionnel de Key_Word, j'ai modifié comme ceci :
Code:
Function Key_word(Chaine As String, occurrence As Integer, Optional Seuil As Integer = 100) As String
Dim s As Variant, T(), T2(), T3(), T4(), T5(), T6(), Tp(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Integer, Borne As Byte, l As Integer
'Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With Sheets("liste")
    Set Liste = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    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(Liste, s(i)) = 0 Then
        dico(s(i)) = dico(s(i)) + 1
    End If
Next i
T = dico.keys
T2 = dico.items
ReDim Tp(LBound(T2) To UBound(T2))
For i = LBound(T2) To UBound(T2)
    Tp(i) = T2(i) / 100
Next i

For i = LBound(Tp) To UBound(Tp)
 If Tp(i) <= Seuil / 100 Then
    ReDim Preserve T3(LBound(T2) To k)
    ReDim Preserve T4(LBound(T2) To k)
    T3(k) = T(i)
    T4(k) = Tp(i)
    k = k + 1
 Else
    ReDim Preserve T5(LBound(T2) To l)
    ReDim Preserve T6(LBound(T2) To l)
    T5(l) = T(i)
    T6(l) = Tp(i)
    l = l + 1
 End If
Next i
Borne = Application.Min(dico.Count, occurrence)
ReDim TOc(1 To Borne)
For i = 1 To Borne
    k = Application.Match(Application.Max(T4), T4, 0) - 1
    TOc(i) = T3(k) & " (" & Format(T4(k), "0%") & ")": T4(k) = ""
Next i
Key_word = Join(TOc, vbLf)
End Function
L'argument optionnel est un nombre qui correspond au seuil du pourcentage maximum choisi (7 signifie que seules les valeurs dont le pourcentage est inférieur ou égal à 7% sont ramenées).
A+
 

Pièces jointes

  • sn4ke_V3.xlsm
    27.3 KB · Affichages: 62
  • sn4ke_V3.xlsm
    27.3 KB · Affichages: 76
  • sn4ke_V3.xlsm
    27.3 KB · Affichages: 79
Dernière édition:

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Bonjour,
Pour la fonction Tag, elle me vas :)
Concernant Key_word, tu tape dans le mille en modifiant la "signification" de l'argument seuil, mais par contre entre parenthèse elle n'affiche plus le pourcentage de présence dans le texte, mais le nombres d’occurrences contrairement aux précédentes versions.
 

david84

XLDnaute Barbatruc
Re : comptage de mots clé...

Bonjour,
Concernant Key_word, tu tape dans le mille en modifiant la "signification" de l'argument seuil, mais par contre entre parenthèse elle n'affiche plus le pourcentage de présence dans le texte, mais le nombres d’occurrences contrairement aux précédentes versions.
Effectivement.
Ci-joint une version modifiée de cette fonction.
Comme je te l'ai précisé, elle peut être épurée car certaines partie du code peuvent être simplifiées voir enlevées.
Mais je le laisse en l'état jusqu'à que tu sois sûr que tout fonctionne (même chose pour les autres fonctions).
Prends le temps de tester soigneusement de ton côté et dis-nous ce qu'il en est.

Code:
Function Key_word(Chaine As String, occurrence As Integer, Optional Seuil As Integer = 100) As String
Dim s As Variant, T(), T2(), T3(), T4(), T5(), T6(), Tp(), TOc(), oRegExp As Object, Matches As Object
Dim i As Double, dico As Object, k As Integer, Borne As Byte, l As Integer
'Application.Volatile
Chaine = Trim(LCase(Replace(Chaine, """", "")))
Set oRegExp = CreateObject("vbscript.regexp")
With Sheets("liste")
    Set Liste = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With oRegExp
  .Global = True
  .MultiLine = True
    'traitement des espaces
    .Pattern = "(\s+|" & Chr(10) & "|" & Chr(13) & ")"
    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(Liste, s(i)) = 0 Then
        dico(s(i)) = dico(s(i)) + 1
    End If
Next i
T = dico.keys
T2 = dico.items
ReDim Tp(LBound(T2) To UBound(T2))
For i = LBound(T2) To UBound(T2)
    Tp(i) = T2(i) / (UBound(s) + 1)
Next i

For i = LBound(Tp) To UBound(Tp)
 If Tp(i) <= Seuil / 100 Then
    ReDim Preserve T3(LBound(T2) To k)
    ReDim Preserve T4(LBound(T2) To k)
    T3(k) = T(i)
    T4(k) = Tp(i)
    k = k + 1
 Else
    ReDim Preserve T5(LBound(T2) To l)
    ReDim Preserve T6(LBound(T2) To l)
    T5(l) = T(i)
    T6(l) = Tp(i)
    l = l + 1
 End If
Next i
Borne = Application.Min(dico.Count, occurrence, UBound(T3))
ReDim TOc(LBound(T3) To Borne)
For i = LBound(T3) To Borne
    k = Application.Match(Application.Max(T4), T4, 0) - 1
    TOc(i) = T3(k) & " (" & Format(T4(k), "0%") & ")": T4(k) = ""
Next i
Key_word = Join(TOc, vbLf)
End Function

Prends également le temps de répondre aux questions que je te pose, notamment celle-ci à laquelle tu n'as pas répondue :
Ceci dit, tes explications ne permettent pas de comprendre si les valeurs qui se répètent doivent apparaître plusieurs fois ou non.
Si c'est la cas, la fonction le permet. Dans le cas contraire, il faudra intégrer un dictionnaire.

Autre question : le pourcentage actuel est calculé sur l'ensemble des mots présents dans la chaîne à traiter, parmi lesquels peuvent figurer des mots présents en colonne A de la feuille liste : est-ce bien ce que tu veux ou doit-on exclure ces mots du calcul du pourcentage ?
A+
 

Sn4ke

XLDnaute Nouveau
Re : comptage de mots clé...

Bonjour :)

Ceci dit, tes explications ne permettent pas de comprendre si les valeurs qui se répètent doivent apparaître plusieurs fois ou non.
Si c'est la cas, la fonction le permet. Dans le cas contraire, il faudra intégrer un dictionnaire.
Effectivement, les mots ne doivent apparaitre qu'une fois.

Autre question : le pourcentage actuel est calculé sur l'ensemble des mots présents dans la chaîne à traiter, parmi lesquels peuvent figurer des mots présents en colonne A de la feuille liste : est-ce bien ce que tu veux ou doit-on exclure ces mots du calcul du pourcentage ?
Oui, c'est ce que je souhaitais, donc aucun changement à ce niveau la.

Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote