Как определить количество неповторяющихся слов в документе - VBA

Узнай цену своей работы

Формулировка задачи:

Здравствуйте, как известно, в документе Word (моя версия - 2010) есть статистика, которая показывает количество символов (всего) в документе. А есть ли такое внутреннее средство Word (или сторонняя программа), которое бы позволило узнать сколько в документе именно слов, причём слов не повторяющихся (если в документе слово, например, "молоко" встречается 10 раз, то учитывалось бы только одно использование)? И было бы неплохо, чтобы это средство (или прога) составила список всех (не повторяющихся) слов, использованных в документе. Если что-то подобное есть, подскажите, пожалуйста! Буду весьма признателен!

Решение задачи: «Как определить количество неповторяющихся слов в документе»

textual
Листинг программы
Sub Частота_слов()      ' cyberforum.ru > KoGG > Sasha_Smirnov-30.9.2015
Const freq = 1 ' частота появления слова в тексте, начиная с которой оно учитывается в словаре
Dim oWord As Range, dic As Object, vX As Variant, S As String
Dim t As String             ' переменная для текста очередного "слова" (oWord.Text)
    Set dic = CreateObject("Scripting.Dictionary")
            Application.ScreenUpdating = False
With dic
        .CompareMode = 0   ' чувствительность к регистру символов при подсчёте слов [1=выкл.]
        
        For Each oWord In ActiveDocument.Range.Words
            t = oWord.Text
                t = Replace(t, Chr(160), Space(1)) ' замена в слове t неразр. пробела на пробел '|
            While InStr(t, Space(2))                                                            '|
                t = Replace(t, Space(2), Space(1)) ' замена в слове t двух и > пробелов на один '|
            Wend                                                                                '|
                If Not Right(t, 1) Like "[ " & Chr(10) & Chr(11) & Chr(13) & "]" Then t = t & " "
                S = UCase(t)
                    Select Case Asc(S)
                    Case 48 To 57, 65 To 90, 168, 184, 192 To 223   ' цифры и ЗАГЛ. буквы
                    .Item(t) = .Item(t) + 1
                    End Select
        Next
        
    Documents.Add: ActiveWindow.ActivePane.View.Type = wdPrintView  ' вид "Разметка страницы"
    For Each vX In .Keys
        If .Item(vX) >= freq Then Selection.TypeText RTrim(vX) & Chr(9) & .Item(vX) & Chr(13)
    Next
End With
        With Selection: .Sort: .Collapse: .Delete: End With         ' Сортировка слов по алфавиту.
    
        ActiveDocument.PageSetup.TextColumns.SetCount NumColumns:=4 ' В 4 колонки.
        ActiveDocument.PageSetup.TextColumns.Spacing = CentimetersToPoints(2) ' 20 мм между колонок
        ActiveDocument.PageSetup.TextColumns.LineBetween = True     ' Линии между колонок.
        
    With ActiveDocument    'установка полей; нумерация строк
        With .PageSetup
        .TopMargin = CentimetersToPoints(1)
        .BottomMargin = CentimetersToPoints(1)
        .LeftMargin = CentimetersToPoints(0.9)
        .RightMargin = CentimetersToPoints(0)
        .LineNumbering.Active = True    ' нумерация строк словаря (не слов! слово может и 2 строки занять)
        .LineNumbering.RestartMode = wdRestartContinuous ' сплошная нумерация строк
        .LineNumbering.DistanceFromText = 1.5 'pt
        End With
    .Paragraphs.TabStops.Add CentimetersToPoints(3.3), wdAlignTabRight ' таб 33 мм c выравниванием вправо
    End With
Set dic = Nothing 'Борис_Р, cyberforum.ru
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 4.167 из 5
Похожие ответы