Нужен скрипт для анализа текста и формирование статистики

@Abbadonus · Регистрация: 17.03.2013

Студворк — интернет-сервис помощи студентам

Программа анализирует произвольный текст (строку) и формирует его статистику. В статистику входит: количество знаков (всех символов, исключая знаки препинания и пробелы), количество абзацев (непустая часть текста между двумя переводами строки), количество предложений (непустая часть текста между двумя точками), количество слов (часть текста между двумя пробелами или знаком препинания и пробелом, частота встречаемости букв (в виде буква - количество раз, сколько она встретилась)

@Апострофф · 17.03.2013, 00:50

Сообщение от Abbadonus

Нужен скрипт

Сразу вопрос - применительно к какому приложению?

@Abbadonus · 17.03.2013, 00:54 **[ТС]**

скрипт должен считывать обычный текстовый файлик.

@gaw · 17.03.2013, 00:56

Сообщение от Abbadonus

обычный

какой размер макс.

@Abbadonus · 17.03.2013, 22:09 **[ТС]**

Сообщение от gaw

какой размер макс.

размер текста или файлика?
если размер текста , то максимально возможный (любой)

Добавлено через 21 час 10 минут
Тварисчи очень нужна ваша помощь!!!!

SoftIce · 18.03.2013, 07:31

Так?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
Option Compare Text
Const AlfaBet As String = "абвгдеёжзийклмнопрстухцчшщъыьэюя" & _
                          "abcdefghijklmnopqrstuvwxyz" & _
                          "1234567890"
Sub Command1_Click()
  Dim i As Integer, ff As Integer, s As String, sTmp As String, nLet As Integer
    ff = FreeFile
    Open App.Path & "\1.txt" For Input As #ff
            s = Input(LOF(ff), 1)
    Close #ff
    's = "йцукенгшщзхъфывапролджэ  ,,..1234567889ячсмитьбюё"
    Text1.Text = s
    sTmp = DelSymb(s)
    List1.AddItem "Слов всего - " & UBound(Split(sTmp)) + 1
    sTmp = Replace(sTmp, " ", "")
    List1.AddItem "Знаков всего - " & Len(sTmp)
    For i = 1 To Len(AlfaBet)
        nLet = UBound(Split(sTmp, Mid(AlfaBet, i, 1)))
        If nLet <> 0 Then List1.AddItem Mid(AlfaBet, i, 1) & "  -  " & nLet
    Next i
End Sub
 
Function DelSymb(ByVal s As String) As String
    Dim st As String, i As Integer
   
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ ]" Then
             st = st & Mid(s, i, 1)
        Else
             st = st & " "
        End If
    Next i
    Do While InStr(1, st, "  ")
             st = Replace(st, "  ", " ")
    Loop
    DelSymb = st
End Function

SoftIce · 18.03.2013, 07:41

Сообщение от Abbadonus

(непустая часть текста между двумя переводами строки)

получается строка, но это ведь не абзац.

@Abbadonus · 18.03.2013, 21:51 **[ТС]**

Да практически то что надо, вот только вопрос, а кол-во предложений можете сделать?
и еще при запуске ругается Ошибка Variable not Defined

SoftIce · 19.03.2013, 22:28

Сообщение от Abbadonus

Variable not Defined

На форме - кнопка, листбокс и текстбокс (Cвойство Multiline = true, вертикальный скролл)

Предложения и абзацы тоже несложно сделать,только пока недосуг.

@Abbadonus · 19.03.2013, 22:29 **[ТС]**

SoftIce, программка хорошая, но мне надо всетаки скрипт который из Excel можно запустить
если можно то в варианте того вбса сделать!

SoftIce · 19.03.2013, 22:31

Да запросто! Только сегодня никак.

@Abbadonus · 19.03.2013, 22:38 **[ТС]**

SoftIce, или подскажите как ее можно адаптировать к той вбс среде

Добавлено через 1 минуту
SoftIce, очень надо...просто горит(((( может подскажите как эо адаптировать или ресурс.. я бы сам попробывал

SoftIce · 19.03.2013, 22:50

Закомментировал чтение из файла, надеюсь, сам разберёшься

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Option Explicit
Option Compare Text
Const AlfaBet As String = "абвгдеёжзийклмнопрстухцчшщъыьэюя" & _
                          "abcdefghijklmnopqrstuvwxyz" & _
                          "1234567890"
Sub TextStatistic()
  Dim i As Long, ff As Integer, s As String, sTmp As String, nLet As Long
    ff = FreeFile
    'Open App.Path & "\1.txt" For Input As #ff
           ' s = Input(LOF(ff), 1)
    'Close #ff
    s = InputBox("Введите текст", "Ввод данных", "йцукенгшщзхъфывапролджэ  ,,..1234567889ю. ячсмитьбюё")
    sTmp = DelSymb(s)
    Cells(1, 1).Value = "Букв     - " & Len(Replace(sTmp, " ", ""))
    Cells(2, 1).Value = "Слов     - " & UBound(Split(sTmp)) + 1
    Cells(3, 1).Value = "Предлож. - " & UBound(Split(LetAndDot(s), "."))
    Cells(4, 1).Value = "Абзацев  - " & Tbl(s)
    For i = 1 To Len(AlfaBet)
        nLet = UBound(Split(sTmp, Mid(AlfaBet, i, 1)))
        If nLet <> 0 Then Cells(4 + i, 1).Value = Mid(AlfaBet, i, 1) & "  -  " & nLet
    Next i
End Sub
 
Function DelSymb(ByVal s As String) As String
    Dim st As String, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ ]" Then
             st = st & Mid(s, i, 1)
        Else
             st = st & " "
        End If
    Next i
    Do While InStr(1, st, "  ")
             st = Replace(st, "  ", " ")
    Loop
    DelSymb = st
End Function
 
Function LetAndDot(ByVal s As String) As String
    Dim st As String, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ.?!]" Then
             st = st & Mid(s, i, 1)
        End If
    Next i
    st = Replace(Replace(st, "!", "."), "?", ".") 'тут немного коряво
    Do While InStr(1, st, "..")
             st = Replace(st, "..", ".")
    Loop
    LetAndDot = st
End Function
 
 
Function Tbl(ByVal s As String) As Integer
    Dim n As Integer, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 3) = vbCrLf & " " Then
             n = n + 1
        End If
    Next i
    Tbl = n + 1
End Function

@Abbadonus · 19.03.2013, 22:54 **[ТС]**

Все работает просто отлично!!!! огромное спасибо!!!!

SoftIce · 20.03.2013, 06:55

Немного изменил одну процедуру, чтобы не было пустых строк и корректно отображались цифры(а то Excel приводил их к дате

)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Option Explicit
Option Compare Text
Const AlfaBet As String = "абвгдеёжзийклмнопрстухцчшщъыьэюя" & _
                          "abcdefghijklmnopqrstuvwxyz" & _
                          "1234567890"
Sub TextStatistic()
  Dim i As Long, ff As Integer, s As String, sTmp As String, nLet As Long, nRow
    ff = FreeFile
    'Open App.Path & "\1.txt" For Input As #ff
           ' s = Input(LOF(ff), 1)
    'Close #ff
    s = InputBox("Введите текст", "Ввод данных", "йцукенгшщзхъфывапролджэ  ,,..1234567889ю. ячсмитьбюё")
    sTmp = DelSymb(s)
    Cells(1, 1).Value = "Букв     - " & Len(Replace(sTmp, " ", ""))
    Cells(2, 1).Value = "Слов     - " & UBound(Split(sTmp)) + 1
    Cells(3, 1).Value = "Предлож. - " & UBound(Split(LetAndDot(s), "."))
    Cells(4, 1).Value = "Абзацев  - " & Tbl(s)
    nRow = 4
    For i = 1 To Len(AlfaBet)
        nLet = UBound(Split(sTmp, Mid(AlfaBet, i, 1)))
        If nLet <> 0 Then nRow = nRow + 1: Cells(nRow, 1).Value = Mid(AlfaBet, i, 1) & "  --  " & nLet
    Next i
End Sub
 
Function DelSymb(ByVal s As String) As String
    Dim st As String, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ ]" Then
             st = st & Mid(s, i, 1)
        Else
             st = st & " "
        End If
    Next i
    Do While InStr(1, st, "  ")
             st = Replace(st, "  ", " ")
    Loop
    DelSymb = st
End Function
 
Function LetAndDot(ByVal s As String) As String
    Dim st As String, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 1) Like "[0-9aA-zZаА-яЯёЁ.?!]" Then
             st = st & Mid(s, i, 1)
        End If
    Next i
    st = Replace(Replace(st, "!", "."), "?", ".") 'тут немного коряво
    Do While InStr(1, st, "..")
             st = Replace(st, "..", ".")
    Loop
    LetAndDot = st
End Function
 
Function Tbl(ByVal s As String) As Integer
    Dim n As Integer, i As Long
    For i = 1 To Len(s)
        If Mid(s, i, 3) = vbCrLf & " " Then
             n = n + 1
        End If
    Next i
    Tbl = n + 1
End Function

Новые блоги и статьи Все статьи Все блоги /
Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ	Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .
Использование значений реквизитов справочника в документе, с определенными условиями и правами Maks 07.04.2026 1. Контроль срока действия договора Алгоритм из решения ниже реализован на примере нетипового документа "ЗаявкаНаРаботу", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если. . .	Доступность команды формы по условию Maks 07.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: сделать доступной кнопку (команда формы "ЗавершитьСписание") при. . .	Уведомление о неверно выбранном значении справочника Maks 06.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "НарядПутевка", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если в документе выбран неверный склад. . .	Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .

@Abbadonus 0 / 0 / 0 Регистрация: 17.03.2013 Сообщений: 20

	Нужен скрипт для анализа текста и формирование статистики 17.03.2013, 00:19. Показов 2918. Ответов 14 Метки нет (Все метки) Программа анализирует произвольный текст (строку) и формирует его статистику. В статистику входит: количество знаков (всех символов, исключая знаки препинания и пробелы), количество абзацев (непустая часть текста между двумя переводами строки), количество предложений (непустая часть текста между двумя точками), количество слов (часть текста между двумя пробелами или знаком препинания и пробелом, частота встречаемости букв (в виде буква - количество раз, сколько она встретилась) 0

@Abbadonus 0 / 0 / 0 Регистрация: 17.03.2013 Сообщений: 20
	17.03.2013, 00:54 [ТС]
	скрипт должен считывать обычный текстовый файлик. 0

@Abbadonus 0 / 0 / 0 Регистрация: 17.03.2013 Сообщений: 20
	18.03.2013, 21:51 [ТС]
	Да практически то что надо, вот только вопрос, а кол-во предложений можете сделать? и еще при запуске ругается Ошибка Variable not Defined 0

@Abbadonus 0 / 0 / 0 Регистрация: 17.03.2013 Сообщений: 20
	19.03.2013, 22:29 [ТС]
	SoftIce, программка хорошая, но мне надо всетаки скрипт который из Excel можно запустить если можно то в варианте того вбса сделать! 0

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	19.03.2013, 22:31
	Да запросто! Только сегодня никак. 0

@Abbadonus 0 / 0 / 0 Регистрация: 17.03.2013 Сообщений: 20
	19.03.2013, 22:38 [ТС]
	SoftIce, или подскажите как ее можно адаптировать к той вбс среде Добавлено через 1 минуту SoftIce, очень надо...просто горит(((( может подскажите как эо адаптировать или ресурс.. я бы сам попробывал 0

@Abbadonus 0 / 0 / 0 Регистрация: 17.03.2013 Сообщений: 20
	19.03.2013, 22:54 [ТС]
	Все работает просто отлично!!!! огромное спасибо!!!! 0

Опции темы

Нужен скрипт для анализа текста и формирование статистики

Решение