| Вопрос: Выделение слов из текста | Добавлено: 05.02.07 15:51 |
Автор вопроса:  Maxxx | Web-сайт: polithelp.sibmediagroup.ru
|
|
Проблема такова: есть RTFBox, в котором содержится произвольный текст. Требуется: выделить из него слова и знанести их в массив. Т.е., чтобы в массив попали только слова: без пробелов, без знаков препинания; если какое-то слово в скобках или кавычках, то эти кавычки и скобки надо убрать и т.д. Я пробовал сам: получались глюки.
Вот мой код: 'Îáúÿâëåíèå ïåðåìåííûõ Public num_char As Long 'êîë-âî ñèìâîëîâ â òåêñòå Public num_word As Long 'êîë-âî ñëîâ â òåêñòå Public num_letter As Long 'êîë-âî áóêâ â òåêñòå Private Sub Ñòàòèñòèêà_Click() Dim abc As String 'õðàíèì òåêñò abc = RichTextBox1.Text 'çàïèñûâàåì â abc òåêñò Dim aaa As Long aaa = Len(abc) 'äëèíà òåêñòà num_char = aaa 'êîë-âî ñèìâîëîâ â ãëîá. ïåðåìåííóþ 'Ñîçäàåì ìàññèâ ñ êîë-ì ýëåìåíòîâ, ðàâíûì êîë-âó ñèìâîëîâ â ñòðîêå 'Dim slova(100) As String ReDim slova(aaa) As String 'ðàçìåð ìàññèâà=êîëè÷åñòâó ñèìâîëîâ â òåêñòå Dim i Dim bukva As String 'õðàíèì òåêóùèé ñèìâîë Dim bukva2 As String 'õðàíèì äâà ñèìâîëà: òåêóùèé+ñëåäóþùèé Dim ii As Long ii = 0 'ñ÷èòûâàåì âñå ñèìâîëû For i = 1 To aaa 'çàíîñèì òåêóùèé ñèìâîë â bukva bukva = Mid(abc, i, 1) 'çàíîñèì äâà ñèìâîëà â bukva2 bukva2 = Mid(abc, i + 1, 1) 'çàíîñèì â ìàññèâ áóêâû ïîäðÿä slova(ii) = slova(ii) & bukva 'ïðîâåðêà: íîâîå ëè ñëîâî If bukva = " " Or bukva2 = "; " Or bukva2 = ". " _ Or bukva2 = ", " Or bukva2 = ": " Or bukva2 = "? " _ Or bukva2 = "! " Or bukva2 = ") " Or bukva = ")" Then 'óäàëÿåì ïðîáåë, ò.å. êðàéíèé ñïðàâà ñèìâîë slova(ii) = Left(slova(ii), Len(slova(ii)) - 1) 'óäàëÿåì ñëåäóþùèé ñèìâîë - çíàê ïðåïèíàíèÿ If Right(slova(ii), 1) = "." Or Right(slova(ii), 1) = ";" _ Or Right(slova(ii), 1) = ":" Or Right(slova(ii), 1) = "," _ Or Right(slova(ii), 1) = "?" Or Right(slova(ii), 1) = "!" _ Or Right(slova(ii), 1) = ")" _ Then slova(ii) = Left(slova(ii), Len(slova(ii)) - 1) 'ïåðåäâèãàåì èíäåêñ ìàññèâà, ÷òîáû ñëåäóþùèå ñèìâîëû 'çàïèñûâàëèñü óæå â äðóãóþ ÿ÷åéêó ìàññèâà ii = ii + 1 End If Next i ReDim Preserve slova(ii) 'óìåíüøàåì ðàçìåð ìàññèâà äî êîë-âà ñëîâ â òåêñòå num_word = ii 'êîë-âî ñëîâ â ãëîá. ïåðåìåííóþ 'âû÷èñëÿåì êîë-âî áóêâ, ò.å. çà âû÷åòîì ïðîáåëîâ è çíàêîâ ïðåïèíàíèÿ num_letter = 0 For i = 0 To num_word num_letter = num_letter + Len(slova(i)) Next i |
| Ответы | Всего ответов: 10 |
|
Номер ответа: 1 Автор ответа:  Sharp Лидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #1 | Добавлено: 05.02.07 17:22 |
|
Простейший конечный автомат, перебираешь в цикле все символы, если символ - буква, добавляешь его к текущему слову, если нет и текущее слово не пустое - выводишь текущее слово и обнуляешь его.
Примерно так: w = ""
for i = 1 to len(s) c = mid(s, i, 1) if is_litera(c) then w = w + c else if w <> "" then msgbox w w = "" end if next |
||
|
Номер ответа: 2 Автор ответа: Maxxx Вопросов: 7 Ответов: 23 |
Web-сайт: Профиль | | #2 | Добавлено: 05.02.07 18:23 |
| А как определить, что символ - это буква? | ||
|
Номер ответа: 3 Автор ответа: Fever Вопросов: 60 Ответов: 808 |
Профиль | | #3 | Добавлено: 05.02.07 19:25 |
|
private function is_litera(byval c as string) as boolean c=lcase(c) is_litera=(asc("a"  <=c) and (c<=asc("z")
end sub |
||
|
Номер ответа: 4 Автор ответа: FeverВопросов: 60 Ответов: 808 |
Профиль | | #4 | Добавлено: 05.02.07 20:06 |
|
Option Explicit
Private mStr As String Private mLen As Long Private mPos As Long Private Sub Text1_Change()  im c As String
im w As String
mStr = Text1 & vbNullChar mLen = Len(mStr) mPos = 0 List1.Clear o
mPos = mPos + 1 c = Mid(mStr, mPos, 1) Select Case c Case "a" To "z", "à" To "ÿ", "A" To "Z", "À" To "ß" w = w & c Case vbNullChar If w <> "" Then List1.AddItem w w = "" End If Exit Do Case Else If w <> "" Then List1.AddItem w w = "" End If End Select Loop End Sub |
||
|
Номер ответа: 5 Автор ответа: FeverВопросов: 60 Ответов: 808 |
Профиль | | #5 | Добавлено: 05.02.07 20:07 |
| Блин эти â достали. | ||
|
Номер ответа: 6 Автор ответа: EROSВопросов: 58 Ответов: 4255  |
Профиль | | #6 | Добавлено: 06.02.07 00:00 |
|
Блин эти â достали.
Наверное какую нибудь фигню типа Mozilla юзаешь? ))) |
||
|
Номер ответа: 7 Автор ответа: avdeyICQ: 219571279 Вопросов: 34 Ответов: 486 |
Профиль | | #7 | Добавлено: 06.02.07 13:16 |
|
2EROS
Да нет, у меня тоже самое с IE... |
||
|
Номер ответа: 8 Автор ответа: EROSВопросов: 58 Ответов: 4255 |
Профиль | | #8 | Добавлено: 06.02.07 14:03 |
| хм.. странно.. у мени никогда такого не было на IE | ||
|
Номер ответа: 9 Автор ответа: FeverВопросов: 60 Ответов: 808 |
Профиль | | #9 | Добавлено: 06.02.07 18:06 |
|
Наверное какую нибудь фигню типа Mozilla юзаешь? )))
Юзаю 
|
||
|
Номер ответа: 10 Автор ответа: FeverВопросов: 60 Ответов: 808 |
Профиль | | #10 | Добавлено: 06.02.07 18:07 |
| 2 Maxxx Не из блоенота копировал? | ||
Страница: 1 |