Compter les mots et la diversité

Télécharger le projet
Commenter

Description

Ce module permet de compter les mots que comporte un texte ainsi que la diversité (ie le nombre de mots utilisés DIFFERENTS pour le texte).

Source / Exemple : 


'UN EXTRAIT SEULEMENT !!! (trop long)
'WordCount : Algorithme de comptage de mots
'et de comptage de la diversité des mots d'un texte
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'     http://www.lesiteweb.fr.st
'__________________________________________________
'Source gratuite, merci de laisser cet en-tête pour
'la redistribution. C. Eyquem - 26 Août 2001

'pour plus d'informations, ceyquem@ifrance.com

Public cTab() As String
Dim Recv As Variant
'cette fonction compte le nombre de mots dans Texte
Public Function CompterLesMots(Texte As String)
Dim i As Integer
Dim j As Integer
ReDim cTab(0 To 29)

'caractères à ignorer lors du comptage...
cTab(0) = ","
cTab(1) = ";"
cTab(2) = ":"
cTab(3) = "!"
cTab(4) = "?"
cTab(5) = "."
cTab(6) = "/"
cTab(7) = "("
cTab(8) = ")"
cTab(9) = "["
cTab(10) = "]"
cTab(11) = "{"
cTab(12) = "}"
cTab(13) = "="
cTab(14) = "+"
cTab(15) = "-"
cTab(16) = "_"
cTab(17) = "'"
cTab(18) = "#"
cTab(19) = "~"
cTab(20) = "%"
cTab(21) = "$"
cTab(22) = "£"
cTab(23) = "*"
cTab(24) = "«"
cTab(25) = "»"
cTab(26) = Chr(34) ' "
cTab(27) = vbCr
cTab(28) = vbLf
cTab(29) = vbTab

'Suppression des caractères à ignorer
For i = LBound(cTab) To UBound(cTab)
    start = 1
    a = InStr(start, Texte, cTab(i), vbTextCompare)
    Do Until a = 0
        Texte = Left$(Texte, a - 1) & " " & Right$(Texte, Len(Texte) - a)
        start = a + 1
        a = InStr(start, Texte, cTab(i), vbTextCompare)
    Loop
Next i

'Suppression des espaces doublons
Do Until i = 0
i = 0
start = 1
a = InStr(start, Texte, "  ", vbTextCompare)
Do Until a = 0
    Texte = Left$(Texte, a - 1) & " " & Right$(Texte, Len(Texte) - a - 1)
    start = a + 1
    a = InStr(start, Texte, "  ", vbTextCompare)
    i = i + 1
Loop
Loop

'Séparation du texte
Recv = Split(Texte, " ")
'Comptage
CompterLesMots = UBound(Recv)

End Function

Conclusion :


Pour tout avoir, cf la source.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ceyquem)