Newsgroup: it.comp.lang.visual-basic
Titolo: R: Conta Parole

 ha scritto nel messaggio
news:iCi5ebc...@newsmst.mcis.galactica.it...


 wrote in message


hehe, troppo facile =)
bisogna contare gli <a capo> e gli apostrofi.
e poi uno spazio che segue un altro spazio per esempio vengono visti come
ben 2 parole mentre non ne costituiscono nemmeno una =(
ho lavorato un po su questo e ho tirato fuori questo codice, che funziona
anche se non mi piace per niente. successivamente cercherò di semplificarlo
e commentarlo.
Function ContaParole(txt As String) As Long
Dim l, Parole As Long
Dim L1, L2, L3, L4 As String
AC = vbCrLf  'Chr(13) + Chr(10) ' Or L2 = AC
Parole = 1
l = Len(txt)
If l > 0 Then
    L1 = Right(txt, 1)
    L2 = Right(txt, 2)
    If L1 = " " Or L1 = "'" Or L2 = AC Then
        Parole = Parole - 1
    End If
End If
For k = 1 To l
    L1 = Mid(txt, k, 1)
    If l < 3 Then
    ElseIf k = 3 Then
        L2 = Mid(txt, (k - 1), 1)
        L3 = Mid(txt, (k - 2), 1)
        L4 = "*NoL4*"
    ElseIf k = 2 Then
        L2 = Mid(txt, (k - 1), 1)
        L3 = "*NoL3*"
        L4 = "*NoL4*"
    ElseIf k = 1 Then
        L2 = "*NoL2*"
        L3 = "*NoL3*"
        L4 = "*NoL4*"
    Else: L2 = Mid(txt, (k - 1), 1)
          L3 = Mid(txt, (k - 2), 1)
          L4 = Mid(txt, (k - 3), 1)
    End If
    If L1 = " " And L2 <> " " And (L3 & L2) <> AC And L2 <> "'" Then Parole
= Parole + 1
    If (L2 & L1) = AC And L3 <> " " And (L4 & L3) <> AC And L3 <> "'" Then
Parole = Parole + 1
    If L1 = "'" And L2 <> " " And (L3 & L2) <> AC And L2 <> "'" Then Parole
= Parole + 1
Next k
If l = 0 Then Parole = 0
If CE1(txt, " ") + CE1(txt, "'") + (CE2(txt, vbCrLf) * 2) = l Then Parole =
0
ContaParole = Parole
End Function
Function CE1(txt As String, ch As String) As Long
l = Len(txt)
c = 0
For k = 1 To l
    If Mid(txt, k, 1) = ch Then c = c + 1
Next k
CE1 = c
End Function
Function CE2(txt As String, ch As String) As Long
l = Len(txt)
c = 0
For k = 1 To l
    If Right(Left(txt, k), 2) = ch Then c = c + 1
Next k
CE2 = c
End Function



prova un po questa:
dim Risult() as string
Public Function ContaParole(TestoFrase As String)
' Cambia gli "a capo" e gli apostrofi in spazi.
provv$ = Replace(TestoFrase, vbCrLf, Chr$(32))
provv$ = Replace(provv$, "'", Chr$(32))
' Toglie i doppi spazi.
Do
provv$ = Replace(provv$, String$(2, 32), Chr$(32))
Loop Until InStr(provv$, String$(2, 32)) = 0
' Se inizia o finisce con uno spazio, lo tronca, perche se no la funzione
successiva non va bene.
If Left$(provv$, 1) = Chr$(32) Then provv$ = Mid$(provv$, 2)
If Right$(provv$, 1) = Chr$(32) Then provv$ = Left$(provv$, Len(provv$) - 1)
' Utilizza la funzione split.
Risult = Split(provv$, Chr$(32))
' Il risultato è l'indice superiore di Risult, aumentato di 1, perche inizia
da 0.
ContaParole = UBound(Risult) + 1
End Function

errata corrige: non funziona in alcuni casi.
ad es., se due parole sono legate da un punto, senza spazi, per un eventuale
errore di battitura, lui le conta come una sola parola.
cmq, va perfezionata, ma per il resto sembra funzionare.
ciao.
mario

 (contando gli <a capo> gli spazi ecc.)
L'ho buttata giЫ in dieci minuti, bisogna aggiustarla sicuramente, perР
lavorandoci un po' sopra dovresti riuscirci.
Ricorda di aggiungere le accentate dove segnalato.
___________________________
Function ContaParole(TestoInput As String)
    Dim N As Integer
    Dim Lunghezza As Integer
    Dim CarattereTest As String
    Dim blnFlag As Boolean
    Dim CarAmmessi As String
    ' aggiungere le accentate meno utilizzate e collaudare
    ' anche con le accentate maiuscole, tipo лих
    CarAmmessi = "ABCDEFGHIJKLMNOPQRSTUVWXYZЮХИЛРЫ"
    Lunghezza = Len(TestoInput)
    For N = 1 To Lunghezza
        CarattereTest = Mid$(TestoInput, N, 1)
        If InStr(1, CarAmmessi, CarattereTest, vbTextCompare) = 0 Then
            If blnFlag = True Then
                ContaParole = ContaParole + 1
                blnFlag = False
            End If
        Else
            blnFlag = True
        End If
    Next N
End Function
___________________________
Bye, G.
--
---------------------------------------------
    Le risposte alle tue domande le trovi
    sul Sito Comune di questo NewsGroup:
 
http://www.murialdo.it/it_lang_vb
       ... e nell'help in linea !
---------------------------------------------
Real E-address: 
gaet...@hotmail.com

geniale...
non sapevo dell'esistenza di InStr =)
la mia funzione effettivamente oltre ad essere lunga e complicata (e lenta)
non tiene conto di cose tipo due parole separate da un punto...
thx,
Olivier
"Paperino" <non...@lo.dico> ha scritto nel messaggio
news:8tvnmi$lf0$1...@stargate1.inet.it...
