Подсчет количества вхождений слова и его форм

  • Автор темы Автор темы Йожег
  • Дата начала Дата начала

Йожег

без телевизора
Топикстартер
12 лет на форуме
Сообщения
8 922
Реакции
4 282
Макрос какой-нибудь для ворда что считает число вхождений слова? Аж любопытно сколь раз упомянут этот "поребрик" Надо чтоб и формы тоже поребрику поребрика и т.д.
 
может просто - команда - Найти и заменить - поребрик -> бордюр - он найдет, заменит и покажет - 125 замен - затем CTRl+Z - и имеем исходный вариант
 
  • Спасибо
Реакции: NNN5 и Йожег
Да, сработало. 130 поребриков заменены на бордюры '))' Для документа в 297 стр не так уж много. В среднем один поребрик на 3 стр. Это просто в начале их по 3-4 на каждой потом видимо автора отомкнуло '))' Но даже в финальной фразе не избежал.
Он тянулся к огню, обещая, чего заведомо не мог выполнить. Тьмы его рук напряглись до предела, дюжины сердец судорожно бились, перегоняя кровь и всасывая живительную влагу далайна, весь он превратился в единый порыв, но жёсткая и невидимая граница останавливала его, не пуская дальше.

— Отдай! — молил он, а крошечный неуязвимый человек стоял у самого поребрика, смеялся над беспомощным богом, и в руках человека горел огонь.
Вот казалось бы бессмертные боги, чудища и прочие гарханзы, да суурь-тэсеги кругом. Но без поребрика нельзя ':(!!' И вот где он его в своем Уссурийске видел?
 
upload_2018-1-28_16-25-50.png

(с) Логинов "Многорукий макаронный монстр"
839f0f_thumb.jpg
 
>И вот где он его в своем Уссурийске видел?

он у нас в Питере живет с годовалого возраста
 
Макрос какой-нибудь для ворда что считает число вхождений слова? Аж любопытно сколь раз упомянут этот "поребрик" Надо чтоб и формы тоже поребрику поребрика и т.д.
Код:
Sub CountWords()
'макрос подсчета количества определенных слов в документе
'для подсчета количества вхождений конкретного слова, это слово должно быть выделено
Dim rng As Range
Dim sWord As String
Dim i As Long
Set rng = ActiveDocument.Range
Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
   MsgBox "Слово не выделено", vbExclamation
Else
'удаляем знак абзаца справа от слова
   If Right(Selection.Text, 1) = Chr(13) Then
      Selection.MoveLeft wdCharacter, 1, wdExtend
   End If
   sWord = Trim(Selection.Text)  'Убираем прообелы вокруг слова и запоминаем
   Selection.Collapse wdCollapseStart
   With rng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = sWord
      .Forward = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .Wrap = wdFindStop
      Do While .Execute
         i = i + 1
      Loop
   End With
   Select Case i
      Case 2 To 4
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раза", _
            vbInformation, "Подсчет слов"
      Case 1
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раз", _
            vbInformation, "Подсчет слов"
      Case Else
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раз", _
            vbInformation, "Подсчет слов"
   End Select
   rng.Find.Text = ""
End If
Application.ScreenUpdating = True
End Sub
 
Можно и не заменять. Ctrl-F (поиск) и так покажет количество:
поребрик-1.jpg
 
этот макрос (он отсюда) считает только слово как есть, без форм.
А вот в такой модификации считает и с формами:
Код:
Sub CountWords_()
'макрос подсчета количества определенных слов в документе
'для подсчета количества вхождений конкретного слова, это слово должно быть выделено
Dim rng As Range
Dim sWord As String
Dim i As Long
Set rng = ActiveDocument.Range
Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
   MsgBox "Слово не выделено", vbExclamation
Else
'удаляем знак абзаца справа от слова
   If Right(Selection.Text, 1) = Chr(13) Then
      Selection.MoveLeft wdCharacter, 1, wdExtend
   End If
   sWord = Trim(Selection.Text)  'Убираем пробелы вокруг слова и запоминаем
   Selection.Collapse wdCollapseStart
   With rng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = sWord
      .Forward = True
      .Format = False
      .MatchCase = False
      .MatchWholeWord = True
      .MatchAllWordForms = True
      .Wrap = wdFindStop
      Do While .Execute
         i = i + 1
      Loop
   End With
   Select Case i
      Case 2 To 4
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раза", _
            vbInformation, "Подсчет слов"
      Case 1
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раз", _
            vbInformation, "Подсчет слов"
      Case Else
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раз", _
            vbInformation, "Подсчет слов"
   End Select
   rng.Find.Text = ""
End If
Application.ScreenUpdating = True
End Sub

upload_2018-1-28_19-34-57.png
 
Последнее редактирование:
  • Спасибо
Реакции: Йожег
теперь йож завсегда будет знать - сколько поребриков в книжках! ура, товарищи!
 
Немного отредактировал макрос.
Он, правда, тоже не все формы считает, а только если выделенное сочетание входит в те формы в таком же виде.
 
хватило бы одной строчки в духе alert("Да, да, Логинов полная чушь, не читай!")
 
  • Спасибо
Реакции: LeonidB и andrejK
Пришлось проверить на себе. Да нет у него рассказы бывают ничего. Книжки писать не умеет это да. Ну и таки надавали ему каких-то премий немеряно. Правда сейчас и букера и нобелевку непойми кому дают.
 
а это его первый роман. я тоже не в восторге, хотя Дивов тут недавно пел дифирамбы по случаю переиздания
 
Дивов как-то связан ныне с изданием книжек.
не своих.

чего б ему не петь? для продаж полезно.
 
Ну вот и Дивов вступил на этот скользкий путь :( Впрочем можно было догадаться когда он начал продвигать свою бывшую. Видать и правда книгописательство перестало быть таким прибыльным занятием если ведущие авторы наперебой обзаводятся литературными неграми. В той или иной форме.
 

Не по теме:
Щас придут злые модераторы и объяснят, куда всем пойти с этими разговорами :)
 
В книжную тему.
 
Плох тот актер, который не мечтает стать режиссером-продюсером