Как определить количество неповторяющихся слов в документе - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д