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