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

@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

Новые блоги и статьи Все статьи Все блоги /
Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .	Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .
Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .	Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .

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

	Нужен скрипт для анализа текста и формирование статистики 17.03.2013, 00:19. Показов 2903. Ответов 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

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

Решение