Comments | heaven_demon: О поиске и замене в MS Word и так, по мелочи

heaven_demon

О поиске и замене в MS Word и так, по мелочи

Nov 05, 2008 21:33

Занимался вот намедни всяческими сексуальными извращениями с текстами очередных аффтаров от медицины в MS Word. И нужно мне было искать и заменять кучу всякой нецензурщины и тарабарщины, ибо аффтары, по большей своей части, русскому языку вовсе не обучены плохо (всё на аглицком кириллицей норовят писать и прочее) и тексты форматировать читабельно ( Read more... )

useful, work, crazy

Leave a comment

Back to all threads

observer_duster May 21 2016, 06:11:42 UTC

Здрасте [спустя много лет]!

может подскажите? [мелкомягкие - это что-то...]

вот есть макрос замены пробелов обычных на неразрывные для "приклеивания" предлогов к словам (чтобы не висели на концах строк).

---- начало кода ----
Sub nbsp_pred()
'
' Замена пробелов на неразрывные
'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "( [ВвСсКк№]) "
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub
--- конец кода ----

К сожалени, в данном случае обрабатываются только однобуквенные предлоги.

Как можно сделать тоже самое, но для двух- и более буквенных предлогов?
Например, для "по", "до" и прочее...

p.s. может так же подскажите, как избавиться от "задваивания" описания предлогов в приведённом макросе? Чтобы регистр был любой.

Хотя в макросе и указано

.MatchCase = False

но, почему-то, на результат это никак не влияет .

Спасибо

heaven_demon September 30 2017, 14:13:26 UTC

Здрасьте [спустя много лет]!

Если ещё актуально: попробуйте просто все двухбуквенные слова приклеивать:
.Text = "([А-я]{1;2})"

Matchcase в случае подстановочных знаков - не помощник.

observer_duster October 1 2017, 17:04:35 UTC

Здрасьте

не понял
конструкция следующая:

.Text = "( [ВвСсКк№]) "
.Replacement.Text = "\1^s"

допустим мне нужно найти "до", "не", "на" и пр.
как ваш .Text = "([А-я]{1;2})" обнаружит именно "до", а не "ли" или любое слово из двух букв?

heaven_demon October 3 2017, 17:14:14 UTC

Я уж думал, Вы сами догадаетесь, что вместо [А-я] нужно подставить искомое вроде [ВвЗзНнаПпоСсДд№]{1;2}.
Как сделать так, чтобы к окончаниям слов, содержащих последними буквы ВвЗзНнаПпоСсДд, ничего не приклеивалось - догадаетесь?

observer_duster October 4 2017, 04:45:52 UTC

большое вам спасибо, что откликаетесь

но хрен там догадаюсь ))) мены бы носом тыкнуть... бейсиковская нотификация какая-то не очень логичная и поэтому трудно запоминаемая/воспринимаемая. Тем более если давлеют годы использования паскалевской нотификации...

Будьте так добры, покажите на конкретном примере для трёх предлогов "на", "до" и "со"
А я уж по аналогии прикручу анологичные.

Да и по аналогии уже сам доделаю для трёхбуквенных предлогов, если понадобится и их приклеивать к словам

спасибо ещё раз

p.s. не-не, не догадаюсь по поводу приклейки к концу слов. Но у меня сейчас вроде однобуквенные союзы никуда не приклеиваются. Там поиск происходит с учётом того, что перед союзом должен быть пробел. И для двух- и более буквенных союзов/предлогов тоже будет выполнятся это условие. Или в вашем варианте это не работает?

heaven_demon October 5 2017, 05:33:55 UTC

Тут как раз всё очень логично)

.Text = "( [ВвЗзНнаПпоСсДд№]{1;2}) "
' Этот текст ищет 1 любую букву или сочетание из 2 указанных букв, то есть предлоги "в", "за", "на", "по", "с", "до", союз "а" (только строчный) и знак номера
.Replacement.Text = "\1^s"

Использование пробела перед [ или просто пробела в конце не всегда корректно отрабатывается, поэтому лучше указать его явным образом (тем более, что их может быть несколько, в том числе - неразрывных):

.Text = "([ ^s]{1;})([ВвЗзНнаПпоСсДд№]{1;2})([ ^s]{1;})"
.Replacement.Text = "\1\2^s"
' или, если нужно оставить только 1 пробел перед предлогом:
.Replacement.Text = " \2^s"

observer_duster October 12 2017, 03:52:48 UTC

Спасибо за ответ.
Тут такое дело по поводу логики... Чёрт ногу сломит с этими значками, правилами обозначения, короче нотификацией...
С трудом отыскал страничку, где напримерах разжёвано что значит что в этих скобках - квадратных, круглых, фигурных... Мелко-мягкие как-то себя не сильно утруждают написанием хелпа - ни в Справке к ворду, ни в своих сайтах-форумах...
http://artefact.lib.ru/design/text_khozyainov.shtml
У меня сейчас сделано вот так:
(простите за простыню - там много ненужных повторов, но я не знаю что именно можно убрать без вреда для исполнения, а на метод "научного тыка" - узнать, что именно можно порезать, времени нет)
хотя (я немножко перфекционист))) очень хотелось бы. Да и красивее и эстетичнее выглядело бы...

Sub DelSpace()
' DelSpace Макрос
'
' УДАЛЯЕМ лишние пробелы (заменяем 2 и более пробелов одним)
'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " {2;}"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveRight Unit:=wdCharacter, Count:=1
'
'УДАЛЯЕМ пробел ПЕРЕД: знаками пунктуации, ")", "%" и концом абзаца
'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " {1;}([.,:;\!c\%)\^0013])"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'
'УДАЛЯЕМ пробел ПОСЛЕ "(" и в начале абзаца (кроме первого - он не хочет удаляться таким методом)
'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([\(^0013])^0032"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'
'ВСТАВЛЯЕМ пробел ПОСЛЕ: знаков пунктуации, "%" и ")", если после них нет запятой, пробела, цифры или конца абзаца
'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([.,:;\!\?\)%])([!^0032^00130123456789,.\!\?])"
.Replacement.Text = "\1^0032\2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'
'ВСТАВЛЯЕМ пробел ПЕРЕД "(", если это не начало абзаца
'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([!^0032^0013])\("
.Replacement.Text = "\1 ("
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1

End Sub

(продолжение в следующем комменте)

observer_duster October 12 2017, 03:53:51 UTC

(продолжение)

точнее, окончание (там из-за кол-ва буковок не прошёл пост полностью)

' ----------------------------------------------------------------------------

Sub nbsp_pred()
'
' Замена пробелов на неразрывные для предлогов...
'
' ...однобуквенных
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "( [ВИКОСУвкосу№]) " ' "и" не нужно, только "И"
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'
' ...многобуквенных
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "( )([В-Св-с])([абзот])( )"
.Replacement.Text = "\1\2\3^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'
' ...отдельно для 'не'
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "( не)( )"
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'
' для чисел
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "( [0-9]) "
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveLeft Unit:=wdCharacter, Count:=1

End Sub

Скажите, что можно убрать из этого "джентельменского набора" нуба?

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
...
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True

Что не меняется при выполнении команды .Execute ?
Тогда бы текст программы стал бы читабельнее и понятнее.

спасибо

heaven_demon October 14 2017, 19:50:00 UTC

Интерпретатору глубоко фиолетово, красивый текст или нет, главное, чтобы синтаксис соответствовал.
Не тратьте время на украшательства. Работает как задумано - и хорошо. Но, что бы было понятнее человеку, оставьте так:

Sub nbsp_pred()
' Замена пробелов на неразрывные для предлогов...

Application.ScreenUpdating = False 'Запрет обновления экрана
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.WholeStory
'
' ...однобуквенных
With Selection.Find
.Text = "( [ВИКОСУвкосу№]{1;1}) " ' "и" не нужно, только "И"
' гораздо проще, чтобы не думать о всякой ерунде - задать весь диапазон с исключением заведомо ненужного ("и", "бы"):
' .Text = "( [А-Я|ав-зй-я№]{1;2}) "
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' ...многобуквенных
With Selection.Find
.Text = "( [В-Св-с]{1;1})([абзоте]{1;1}) " ' для "не" не нужно городить отдельный цикл
' да и вообще логично будет просто склеивать все 2-буквенные слова с последующими, вне зависимости от регистра, а потом при корректуре разбираться, если где-то ерунда вышла и чистить её руками:
' .Text = "( [А-я]{2;2}) "
'а ещё лучше убрать весь раздел и оставить в соответствии с моим предыдущим комментарием, так как он покрывает и 2-буквенные слова
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' для чисел
With Selection.Find
.Text = "( [0-9]{1;}) "
.Replacement.Text = "\1^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

observer_duster October 16 2017, 06:29:47 UTC

"Интерпретатору глубоко фиолетово... Но, что бы было понятнее человеку..."

Про интерпретатор я в курсе ))) речь как раз про человека (про меня) - тяжело листать простыни с однообразными повторами в поисках смыла преобразований.

"да и вообще логично будет просто склеивать все 2-буквенные слова с последующими, вне зависимости от регистра, а потом при корректуре разбираться, если где-то ерунда вышла и чистить её руками"

не, не, не.... только не руками. Это делается для дам, не слишком обременённых интеллектом, внимательностью и усердием в работе. Тут потом проще допилить руками, чем убрать/вычистить.
Они же не понимают, что такое неразрывный пробел, где его искать и зачем это всё нужно...
Тут лучше недобдеть, чем перебдеть. Слишком хорошо - тоже не хорошо.
А так - нажмал кнопку и усё готово, основные косяки удалены.

Спасибо за помощь

heaven_demon October 30 2017, 19:03:47 UTC

Пожалуйста)

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

teddyslaf December 25 2019, 15:44:42 UTC

Если все замены отличаются лишь тектом поиска и новым текстом, то можно такие тексты парами добавить в коллекцию, а затем циклом обойти такую коллекцию.
Например:

Sub НашаЗамена

Dim Rt(2) As String ' массив строк для хранения пары текстов
Dim collRt As Collection ' коллекция таких пар

Set collRt = New Collection

Rt(1) = " "
Rt(2) = " "
collRt.Add Rt

Rt(1) = " "
Rt(2) = " "
collRt.Add Rt

Rt(1) = "^p "
Rt(2) = "^p"
collRt.Add Rt

Rt(1) = " ^p"
Rt(2) = "^p"
collRt.Add Rt

Rt(1) = "^p-"
Rt(2) = "^p-"
collRt.Add Rt

Rt(1) = "^p*"
Rt(2) = "^p-"
collRt.Add Rt

ЗаменитьМассово collRt

End Sub

Sub ЗаменитьМассово(collRt As Collection)
' Dim y As Integer
Dim n As Integer

' y = 0
For Each curRt In collRt
' y = y + 1
' Debug.Print " " & y & "." & curRt(1) & ">станет." & curRt(2) & "."
res = True
n = 0
Do
Selection.WholeStory
Selection.ClearFormatting
Selection.HomeKey Unit:=wdLine

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = curRt(1)
.Replacement.Text = curRt(2)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
res = Selection.Find.Execute(Replace:=wdReplaceAll)
n = n + 1
' Debug.Print " " & n & " проход " & res & "."
' если зациклилось то прекратим
If n > 5 Then res = False

Loop Until res = False
Next curRt

End Sub

Back to all threads