2013 - Анализ текста

Invincible · Сообщение **Invincible** » 07 окт 2015, 22:28

Всем привет.

Можете подсказать, можно в Word производить такой анализ текста: разбить текст на слова, посчитать количество повторяющихся слов в тексте, найти пары слов наиболее связанных друг с другом и посчитать их количество?

Invincible · Сообщение **Invincible** » 07 окт 2015, 22:28

Invincible, можно. Макросом.

Цитата Invincible:

пары слов наиболее связанных друг с другом

2013 - Анализ текста

Что это значит?

Invincible · Сообщение **Invincible** » 07 окт 2015, 22:28

Цитата Iska:

Что это значит?

2013 - Анализ текста

Пары слов, которые чаще всего встречаются, проще говоря их количество

Invincible · Сообщение **Invincible** » 08 окт 2015, 08:57

Цитата Iska:

можно. Макросом.

2013 - Анализ текста

А у вас нету такого макроса? А то я в них не силен

Invincible · Сообщение **Invincible** » 08 окт 2015, 21:38

Цитата Invincible:

Пары слов

2013 - Анализ текста

«Пару слов» понимать как стоящие рядом друг с другом? В строгом порядке или произвольном: «мама мыла» и «мыла мама» — это должно числиться как одна пара или как две разных пары?

Цитата Invincible:

А у вас нету такого макроса?

2013 - Анализ текста

Нет. Его надо написать.

Например, для первой части:

Цитата Invincible:

разбить текст на слова, посчитать количество повторяющихся слов в тексте,

2013 - Анализ текста

Код:

Код: Выделить всё

Option Explicit
Sub Sample()
    Dim objWord As Range
    Dim strWord As String
    Dim objDictionary As Object
    Dim elem As Variant
    Set objDictionary = CreateObject("Scripting.Dictionary")
    For Each objWord In ThisDocument.Words
        strWord = Trim(Replace(objWord.Text, vbCr, ""))
        If Not Len(strWord) = 0 Then
            If Not objDictionary.Exists(strWord) Then
                objDictionary.Add strWord, 1
            Else
                objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
            End If
        End If
    Next
    For Each elem In objDictionary.Keys
        Debug.Print "[" & elem & "]", objDictionary.Item(elem)
    Next
End Sub

Надо понимать, что у Word'а своё понимание понятия «слова», оно может быть отличным от Вашего. Например, данная страница может давать такой набор «слов»:

Скрытый текст

[spoiler]Код:

[/spoiler]

Код: Выделить всё

[Invincible]   6 
[вне]          2 
[форума]       2 
[Старожил]     2 
[Сообщения]    3 
[:]            13 
[171]          2 
[Благодарности]              3 
[1]            2 
[   ]          3 
[Профиль]      3 
[|]            12 
[Отправить]    3 
[PM]           3 
[Цитировать]   3 
[Сообщить]     3 
[модератору]   3 
[Всем]         1 
[привет]       1 
[.]            3 
[Можете]       1 
[подсказать]   1 
[,]            8 
[можно]        2 
[в]            2 
[Word]         1 
[производить]  1 
[такой]        1 
[анализ]       1 
[текста]       1 
[разбить]      1 
[текст]        1 
[на]           2 
[слова]        1 
[посчитать]    2 
[количество]   3 
[повторяющихся]              1 
[слов]         4 
[тексте]       1 
[найти]        1 
[пары]         2 
[наиболее]     2 
[связанных]    2 
[друг]         2 
[с]            2 
[другом]       2 
[и]            1 
[их]           2 
[?]            3 
[Полезное]     1 
[сообщение]    1 
[Отправлено]   2 
[23]           1 
[28]           1 
[Вчера]        1 
[Iska]         3 
[сейчас]       1 
[форуме]       1 
[Ветеран]      1 
[Contributor]  1 
[14335]        1 
[4358]         1 
[Редактировать]              1 
[Макросом]     1 
[Цитата]       2 
[»]            2 
[Что]          2 
[это]          2 
[значит]       2 
[09]           1 
[57]           1 
[Сегодня]      1 
[#]            1 
[2]            1 
[Автор]        1 
[темы]         1 
[Пары]         1 
[которые]      1 
[чаще]         1 
[всего]        1 
[встречаются]  1 
[проще]        1 
[говоря]       1

Iska · Сообщение **Iska** » 09 окт 2015, 06:01

Цитата Iska:

«мама мыла» и «мыла мама» — это должно числиться как одна пара или как две разных пары?

2013 - Анализ текста

Как одна пара слов

Invincible · Сообщение **Invincible** » 09 окт 2015, 07:17

Invincible, давайте попробуем так:

Скрытый текст

[spoiler]Код:

[/spoiler]

Код: Выделить всё

Option Explicit
Sub Sample()
    Dim objWord As Range
    Dim strWord As String
    Dim objDictionary As Object
    Dim elem As Variant
    Dim strWord1 As String
    Dim strWord2 As String
    Dim i As Integer
    Set objDictionary = CreateObject("Scripting.Dictionary")
    For Each objWord In ThisDocument.Words
        strWord = RemoveNonAlpha(objWord.Text)
        If Not Len(strWord) = 0 Then
            If Not objDictionary.Exists(strWord) Then
                objDictionary.Add strWord, 1
            Else
                objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
            End If
        End If
    Next
    For Each elem In objDictionary.Keys
        Debug.Print "[" & elem & "]", objDictionary.Item(elem)
    Next
    objDictionary.RemoveAll
    Debug.Print "===================================================================="
    For i = 1 To ThisDocument.Words.Count - 1
        strWord1 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i).Text))
        strWord2 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i + 1).Text))
        If Len(strWord1) > 0 And Len(strWord2) > 0 Then
            If StrComp(strWord1, strWord2, vbTextCompare) = 1 Then
                strWord = strWord2 & " " & strWord1
            Else
                strWord = strWord1 & " " & strWord2
            End If
            If Not objDictionary.Exists(strWord) Then
                objDictionary.Add strWord, 1
            Else
                objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
            End If
        End If
    Next
    For Each elem In objDictionary.Keys
        Debug.Print "[" & elem & "]", objDictionary.Item(elem)
    Next
    objDictionary.RemoveAll
    Set objDictionary = Nothing
End Sub
Function RemoveNonAlpha(strValue As String) As String
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Global = True
        .Multiline = True
        .Pattern = "([^a-zа-яё])*"
        RemoveNonAlpha = .Replace(strValue, "")
    End With
End Function

Дополнительно будем удалять из «слов» Word'а все небуквенные символы, а то как-то больно нелепо смотрятся слова из знаков препинания, цифр, кавычек и т.п.

Пример для текста со страницы

Темпы распространения Windows 10 за два месяца опережают Windows 7

:

Скрытый текст

[spoiler]Код:

[/spoiler]

Код: Выделить всё

[популярной]   1 
[из]           1 
[когда]        1 
[либо]         1 
[выпущенных]   1 
[операционных]               1 
[систем]       1 
[для]          2 
[персональных]               1 
[компьютеров]  1 
[Поэтому]      1 
[показатели]   1 
[распространения]            2 
[сравнивают]   1 
[именно]       1 
[с]            1 
[ней]          1 
[Статистика]   1 
[от]           1 
[NetMarketShare]             1 
[показывает]   1 
[что]          1 
[в]            5 
[первые]       1 
[два]          2 
[месяца]       2 
[после]        3 
[релиза]       1 
[дела]         1 
[идут]         1 
[лучше]        1 
[чем]          2 
[у]            2 
[за]           2 
[аналогичный]  1 
[промежуток]   1 
[времени]      1 
[У]            1 
[результат]    2 
[намного]      1 
[ниже]         1 
[как]          1 
[наглядно]     1 
[показано]     1 
[графике]      1 
[Доля]         2 
[достигла]     1 
[значения]     1 
[против]       1 
[привлекла]    1 
[своё]         1 
[время]        1 
[внимание]     1 
[только]       1 
[Однако]       1 
[демонстрировала]            1 
[стабильные]   1 
[результаты]   1 
[течение]      1 
[девяти]       1 
[месяцев]      1 
[чего]         1 
[её]           1 
[темпы]        1 
[выросли]      1 
[ещё]          1 
[больше]       1 
[а]            2 
[во]           1 
[второй]       1 
[месяц]        1 
[устанавливали]              1 
[примерно]     1 
[три]          1 
[раза]         1 
[меньше]       1 
[первый]       1 
[через]        1 
[лет]          1 
[появления]    1 
[составляет]   2 
[около]        1 
[целью]        1 
[распространение]            1 
[млрд]         1 
[устройств]    1 
[пока]         1 
[же]           1 
[млн]          1 
====================================================================
[операционная система]       1 
[windows система]            1 
[исправить призвана]         1 
[исправить недостатки]       1 
[версии недостатки]          1 
[windows версии]             1 
[главным однако]             1 
[главным стремлением]        1 
[microsoft стремлением]      1 
[microsoft является]         1 
[переманить является]        1 
[на переманить]              1 
[на неё]       1 
[многочисленных неё]         1 
[многочисленных пользователей]             1 
[windows пользователей]      1 
[на последняя]               1 
[данный на]    1 
[данный момент]              1 
[момент уверенно]            1 
[лидирует уверенно]          1 
[и лидирует]   1 
[и может]      1 
[может считаться]            1 
[самой считаться]            1 
[популярной самой]           1 
[из популярной]              1 
[из когда]     1 
[выпущенных либо]            1 
[выпущенных операционных]    1 
[операционных систем]        1 
[для систем]   1 
[для персональных]           1 
[компьютеров персональных]   1 
[показатели поэтому]         1 
[показатели распространения]               1 
[windows распространения]    1 
[именно сравнивают]          1 
[именно с]     1 
[ней с]        1 
[от статистика]              1 
[netmarketshare от]          1 
[netmarketshare показывает]  1 
[в что]        1 
[в первые]     1 
[два первые]   1 
[два месяца]   2 
[месяца после]               1 
[после релиза]               1 
[дела релиза]  1 
[windows дела]               1 
[идут лучше]   1 
[у чем]        1 
[windows у]    3 
[аналогичный за]             1 
[аналогичный промежуток]     1 
[времени промежуток]         1 
[намного результат]          1 
[намного ниже]               1 
[как наглядно]               1 
[наглядно показано]          1 
[на показано]  1 
[графике на]   1 
[windows доля]               2 
[два за]       1 
[достигла месяца]            1 
[достигла значения]          1 
[в привлекла]  1 
[в своё]       1 
[время своё]   1 
[внимание время]             1 
[внимание только]            1 
[windows однако]             1 
[демонстрировала стабильные]               1 
[результаты стабильные]      1 
[в результаты]               1 
[в течение]    1 
[девяти течение]             1 
[девяти месяцев]             1 
[после чего]   1 
[её чего]      1 
[её темпы]     1 
[распространения темпы]      1 
[выросли распространения]    1 
[выросли ещё]  1 
[больше ещё]   1 
[windows а]    1 
[во второй]    1 
[второй месяц]               1 
[месяц устанавливали]        1 
[примерно устанавливали]     1 
[в примерно]   1 
[в три]        1 
[раза три]     1 
[меньше раза]  1 
[в чем]        1 
[в первый]     1 
[лет после]    1 
[после появления]            1 
[появления составляет]       1 
[около составляет]           1 
[а для]        1 
[windows для]  1 
[целью является]             1 
[распространение является]   1 
[на распространение]         1 
[же пока]      1 
[же результат]               1 
[результат составляет]       1

Iska · Сообщение **Iska** » 10 окт 2015, 10:18

Invincible, давайте попробуем так:

Скрытый текст

[spoiler]Код:

[/spoiler]

Код: Выделить всё

Option Explicit
Sub Sample()
    Dim objWord As Range
    Dim strWord As String
    Dim objDictionary As Object
    Dim elem As Variant
    Dim strWord1 As String
    Dim strWord2 As String
    Dim i As Integer
    Set objDictionary = CreateObject("Scripting.Dictionary")
    For Each objWord In ThisDocument.Words
        strWord = RemoveNonAlpha(objWord.Text)
        If Not Len(strWord) = 0 Then
            If Not objDictionary.Exists(strWord) Then
                objDictionary.Add strWord, 1
            Else
                objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
            End If
        End If
    Next
    For Each elem In objDictionary.Keys
        Debug.Print "[" & elem & "]", objDictionary.Item(elem)
    Next
    objDictionary.RemoveAll
    Debug.Print "===================================================================="
    For i = 1 To ThisDocument.Words.Count - 1
        strWord1 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i).Text))
        strWord2 = LCase(RemoveNonAlpha(ThisDocument.Words.Item(i + 1).Text))
        If Len(strWord1) > 0 And Len(strWord2) > 0 Then
            If StrComp(strWord1, strWord2, vbTextCompare) = 1 Then
                strWord = strWord2 & " " & strWord1
            Else
                strWord = strWord1 & " " & strWord2
            End If
            If Not objDictionary.Exists(strWord) Then
                objDictionary.Add strWord, 1
            Else
                objDictionary.Item(strWord) = objDictionary.Item(strWord) + 1
            End If
        End If
    Next
    For Each elem In objDictionary.Keys
        Debug.Print "[" & elem & "]", objDictionary.Item(elem)
    Next
    objDictionary.RemoveAll
    Set objDictionary = Nothing
End Sub
Function RemoveNonAlpha(strValue As String) As String
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Global = True
        .Multiline = True
        .Pattern = "([^a-zа-яё])*"
        RemoveNonAlpha = .Replace(strValue, "")
    End With
End Function

Дополнительно будем удалять из «слов» Word'а все небуквенные символы, а то как-то больно нелепо смотрятся слова из знаков препинания, цифр, кавычек и т.п.

Пример для текста со страницы

Темпы распространения Windows 10 за два месяца опережают Windows 7

:

Скрытый текст

[spoiler]Код:

[/spoiler]

Код: Выделить всё

[популярной]   1 
[из]           1 
[когда]        1 
[либо]         1 
[выпущенных]   1 
[операционных]               1 
[систем]       1 
[для]          2 
[персональных]               1 
[компьютеров]  1 
[Поэтому]      1 
[показатели]   1 
[распространения]            2 
[сравнивают]   1 
[именно]       1 
[с]            1 
[ней]          1 
[Статистика]   1 
[от]           1 
[NetMarketShare]             1 
[показывает]   1 
[что]          1 
[в]            5 
[первые]       1 
[два]          2 
[месяца]       2 
[после]        3 
[релиза]       1 
[дела]         1 
[идут]         1 
[лучше]        1 
[чем]          2 
[у]            2 
[за]           2 
[аналогичный]  1 
[промежуток]   1 
[времени]      1 
[У]            1 
[результат]    2 
[намного]      1 
[ниже]         1 
[как]          1 
[наглядно]     1 
[показано]     1 
[графике]      1 
[Доля]         2 
[достигла]     1 
[значения]     1 
[против]       1 
[привлекла]    1 
[своё]         1 
[время]        1 
[внимание]     1 
[только]       1 
[Однако]       1 
[демонстрировала]            1 
[стабильные]   1 
[результаты]   1 
[течение]      1 
[девяти]       1 
[месяцев]      1 
[чего]         1 
[её]           1 
[темпы]        1 
[выросли]      1 
[ещё]          1 
[больше]       1 
[а]            2 
[во]           1 
[второй]       1 
[месяц]        1 
[устанавливали]              1 
[примерно]     1 
[три]          1 
[раза]         1 
[меньше]       1 
[первый]       1 
[через]        1 
[лет]          1 
[появления]    1 
[составляет]   2 
[около]        1 
[целью]        1 
[распространение]            1 
[млрд]         1 
[устройств]    1 
[пока]         1 
[же]           1 
[млн]          1 
====================================================================
[операционная система]       1 
[windows система]            1 
[исправить призвана]         1 
[исправить недостатки]       1 
[версии недостатки]          1 
[windows версии]             1 
[главным однако]             1 
[главным стремлением]        1 
[microsoft стремлением]      1 
[microsoft является]         1 
[переманить является]        1 
[на переманить]              1 
[на неё]       1 
[многочисленных неё]         1 
[многочисленных пользователей]             1 
[windows пользователей]      1 
[на последняя]               1 
[данный на]    1 
[данный момент]              1 
[момент уверенно]            1 
[лидирует уверенно]          1 
[и лидирует]   1 
[и может]      1 
[может считаться]            1 
[самой считаться]            1 
[популярной самой]           1 
[из популярной]              1 
[из когда]     1 
[выпущенных либо]            1 
[выпущенных операционных]    1 
[операционных систем]        1 
[для систем]   1 
[для персональных]           1 
[компьютеров персональных]   1 
[показатели поэтому]         1 
[показатели распространения]               1 
[windows распространения]    1 
[именно сравнивают]          1 
[именно с]     1 
[ней с]        1 
[от статистика]              1 
[netmarketshare от]          1 
[netmarketshare показывает]  1 
[в что]        1 
[в первые]     1 
[два первые]   1 
[два месяца]   2 
[месяца после]               1 
[после релиза]               1 
[дела релиза]  1 
[windows дела]               1 
[идут лучше]   1 
[у чем]        1 
[windows у]    3 
[аналогичный за]             1 
[аналогичный промежуток]     1 
[времени промежуток]         1 
[намного результат]          1 
[намного ниже]               1 
[как наглядно]               1 
[наглядно показано]          1 
[на показано]  1 
[графике на]   1 
[windows доля]               2 
[два за]       1 
[достигла месяца]            1 
[достигла значения]          1 
[в привлекла]  1 
[в своё]       1 
[время своё]   1 
[внимание время]             1 
[внимание только]            1 
[windows однако]             1 
[демонстрировала стабильные]               1 
[результаты стабильные]      1 
[в результаты]               1 
[в течение]    1 
[девяти течение]             1 
[девяти месяцев]             1 
[после чего]   1 
[её чего]      1 
[её темпы]     1 
[распространения темпы]      1 
[выросли распространения]    1 
[выросли ещё]  1 
[больше ещё]   1 
[windows а]    1 
[во второй]    1 
[второй месяц]               1 
[месяц устанавливали]        1 
[примерно устанавливали]     1 
[в примерно]   1 
[в три]        1 
[раза три]     1 
[меньше раза]  1 
[в чем]        1 
[в первый]     1 
[лет после]    1 
[после появления]            1 
[появления составляет]       1 
[около составляет]           1 
[а для]        1 
[windows для]  1 
[целью является]             1 
[распространение является]   1 
[на распространение]         1 
[же пока]      1 
[же результат]               1 
[результат составляет]       1

Invincible · Сообщение **Invincible** » 10 окт 2015, 14:13

Цитата Invincible:

но в документе где находится мой текст никаких изменений не происходит

2013 - Анализ текста

А разве там должны происходить какие-либо изменения?

Находясь в редакторе VBA, попробуйте нажать «Ctrl-G» для отображения окна «Immediate», куда идёт вывод «Debug.Print».

При желании, конечно, можно сделать вывод в новый документ Word или в текстовый файл на диске.

Invincible · Сообщение **Invincible** » 10 окт 2015, 15:09

Цитата Iska:

А разве там должны происходить какие-либо изменения?

Находясь в редакторе VBA, попробуйте нажать «Ctrl-G» для отображения окна «Immediate», куда идёт вывод «Debug.Print».

2013 - Анализ текста

Все получилось, просто я думал, что результат работы макроса заменит исходный текст.

А нельзя добавить, чтобы учитывались падежи слов? Чтобы слово из-за разного окончания слова относилось к одному слову, а не к 5 например.

И еще союзы, предлоги, частицы удалить из текста, такие как "и", "а".

2013 - Анализ текста

2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста

Re: 2013 - Анализ текста