- '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
-
'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