Статьи из блога
Замена жаргонных слов в тексте
Андрей работает с документами, в которых встречаются жаргонные или специфические слова. Ему нужен инструмент, позволяющий быстро находить и заменять такие слова нормальными более верными и корректными. Например, словосочетание "Русский хелп" следовало бы заменить на "Русский файл помощи", и другие слова и словосочетания в том же духе.
Андрей предположил, что необходимо использовать макрос для этих целей. И он написал такой макрос с помощью автоматического макрорекордера Word. Однако столкнулся с проблемой: слов много, а объем макроса ограничен и добавление новых блоков (блоков поиска и замены новых слов) стало однажды невозможным.
Андрей интересуется, можно ли как-то усовершенствовать его макрос и иметь возможность работать с большим количеством слов, чем это доступно ему сейчас.
Я предложил использовать следующий макрос (ниже). В нем есть две строки, которые пользователь должен подредактировать под свои нужды. Вот эти строки:
vFindText = Array("Русский фейс", "Русский хелп", "урод", "дебил")
vReplText = Array("Интерфейс - русский", "Русский файл помощи", "красавец", "умнейший человек")
В первый список (в скобках) заносите через запятую (по образцу) жаргонные слова, а во второй список - правильные. Но они должны совпадать по нумерации следования с жаргонными. То есть, если в первом списке словосочетание "русский хелп" идет первым, то во втором списке словосочетание "русская помощь" также должно идти первым.
Слова можно добавлять без ограничения (в разумных пределах, наверное).
Sub ak_compSleng()
'замена жаргонных слов на литературные
Dim sText As Range
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
Set sText = ActiveDocument.Range
'список жаргонных слов в массиве
vFindText = Array("Русский фейс", "Русский хелп", "урод", "дебил")
'список правильных слов в массиве
'слова из жаргонного списка должны корреспондировать
'со словами из правильного списка
vReplText = Array("Интерфейс - русский", "Русский файл помощи", "красавец", "умнейший человек")
With sText.Find
'заменяем слова из жаргонного списка на
'слова из правильного списка
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute Replace:=wdReplaceAll
Next i
End With
End Sub
Если вы не знаете, как подключить к документу и применить эти макросы, изучите следующие заметки с сайта:
Создание макроса из готового кода
Метки: макросы | поиск и замена
Просмотров: 27890
Подписаться на комментарии по RSS
Версия для печати
Еще записи по вопросам использования Microsoft Word:
- 10 вопросов и ответов по редактору Word (1 часть)
- 3 способа очистки списка недавно открытых документов
- Word 2007: добавляем свою вкладку и свои команды
- Word 2007: полотно, рисунки, линии
- Word 2007: смена формата сохранения файла
- Word 97 - решение проблемы с отображением символов на линейке
- Абзац с цветным фоном
- Автоматизация текстового набора в Word
- Автоматическая запись макроса
- Автоматическая нумерация билетов
- Автоматическая расстановка переносов
- Автоматическое обновление полей при открытии документа
- Автоматическое сохранение документа при его закрытии
- Автотекст с последовательной нумерацией
- Белый текст на синем фоне в Word 2007
- Быстрая смена ориентации страниц документа
- Быстрое перемещение между открытыми документами Word
- Быстрое создание нового документа на основе шаблона
- Быстрый ввод текста с помощью команды =rand()
- Ввод повторяющихся фрагментов текста в Word 2007
- Ввод часто повторяющихся фрагментов текста
- Вертикальное выравнивание текста
- Возможно ли запретить копирование текста из документа Word?
- Вопрос о работе с графиками (диаграммами) в Word
- Вопросы и ответы о гиперссылках в редакторе Word

Форум
Читают
Обсуждают
страницы
сайты
статистика
Комментариев: 37
А почему не воспользоваться встроенной в Word автозаменой? Работает вполне корректно...
Немного неудобно редактировать такой список слов. Я предлагаю модернизировать макрос так. В отдельный документ записать таблицу жаргонных слов и их перевода. В таблице - две колонки, в первой - жаргон, во второй - перевод.
Им будет пользоваться такой макрос:
Public Type WordPair original As String translation As String End Type Private Function CollectDictionary(ByVal path As String) As WordPair() Dim doc As Document Dim currRow As row Dim pair As WordPair Dim pairs() As WordPair Dim original As String Dim translation As String Set doc = Documents.Open(path, ReadOnly:=True) For Each currRow In doc.Tables(1).Rows original = currRow.Cells(1).Range.Text translation = currRow.Cells(2).Range.Text pair.original = Left(original, Len(original) - 1) pair.translation = Left(translation, Len(translation) - 2) ReDim Preserve pairs(currRow.Index) pairs(currRow.Index) = pair Next doc.Close CollectDictionary = pairs End Function Public Sub Translate() Dim documentPath As String Dim pairs() As WordPair Dim pair As WordPair Dim i As Integer documentPath = InputBox("Path to the document containing dictionary", "Dictionary") pairs = CollectDictionary(documentPath) With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = 1 To UBound(pairs) .Text = Left(pairs(i).original, Len(pairs(i).original) - 1) .Replacement.Text = pairs(i).translation .Execute Replace:=wdReplaceAll Next End With End SubКогда после запуска макроса открывается диалог, ввести путь к документу, в котором записана таблица со словарём.
Полезная утилита, которую можно ипсользовать и для замены кратко записанного текста.
Но почему-то не заменяется жаргонное слова "МП1У" на "Магистральная подсистема 1-ого уровня"
Получается тольки замена до цифры "Магистральная подсистема1У"
Что нужно изменить в настройках поиска, чтобы полностью работал макрос ?
Дмитрий, у меня эта замена сработала (по крайней мере тот вариант, который в моём комментарии
. Посмотрите внимательно на ваш список слов. Нет ли в нём перевода просто "МП" на "Магистральная подсистема"?
Леонид,
Вы правы - есть "Магистральная подсистема"
Спасибо
С Уважением, Дмитрий.
А как добавить счетчик на каждое словосочетание?
To Дима:
Что вы имеете в виду?
Подскажите возможноли осуществить поиск не известного текста, при условии что знаем первое слово или словосочетание и последнее слово или словосочетание, а неизвестный тект открытьили сохранить в другом документе.
Возможно. Хотелось бы более конкретного примера: откуда берутся начальные и конечные слова, куда выводить результат поиска.
Спасибо за ответ:
Постоянно приходят документы с примерным текстом:
Контрольные значения файлов дистрибутива
Автоматизированная система повышения квалификации (АСПК)
1. Носители информации с файлами дистрибутива
Контрольные значения файлов дистрибутива- фраза постоянна и известна
Автоматизированная система повышения квалификации – неизвестная фраза (которую надо найти)
После чего обязательно пустая строка.
Носители информации с файлами дистрибутива- фраза постоянна и известна
Хотелось бы из комндной строки запустить word выполнить макрос найти строку и сохранить в обычном txt файле для дальнейшей обработки батником.
Ну, если текст действительно так выглядит, и нужно сохранить только то, что между известными строками, тогда могу предложить такой макрос.
Sub FindUnknownText() Dim oDoc As Document: Set oDoc = ActiveDocument Dim lStart&, lEnd& With oDoc.Range.Find ' .Text = InputBox("Введите первую строку, ограничивающую текст", _ ' "Поиск неизвестного фрагмента", _ ' "Контрольные значения файлов дистрибутива") .Text = "Контрольные значения файлов дистрибутива" .MatchCase = True: .Wrap = wdFindStop .Execute If .Found Then lStart = .Parent.Paragraphs(1).Range.End End With With oDoc.Range(lStart, oDoc.Range.End).Find ' .Text = InputBox("Введите вторую строку, ограничивающую текст", _ ' "Поиск неизвестного фрагмента", _ ' "Носители информации с файлами дистрибутива") .Text = "Носители информации с файлами дистрибутива" .MatchCase = True: .Wrap = wdFindStop .Execute If .Found Then lEnd = .Parent.Paragraphs(1).Range.Start End With With Documents.Add .Range.InsertAfter oDoc.Range(lStart, lEnd).Text .SaveAs oDoc.Name & ".txt", fileformat:=wdFormatText MsgBox "Документ сохранен." & vbCr & .FullName .Close End With End SubКак запустить макрос из командной строки, читаем здесь http://support.microsoft.com/kb/210565/ru
Если раскомментировать строки с InputBox, то можно будет задавать начальную и конечную строку для поиска фрагмента между ними.
Леониду Бродскому!
Макрос не работает
Private Function CollectDictionary(ByVal path As String) As WordPair()
Compile еrror:
User-def ned type not def ned
если можно -помогите запустить
Игорю:
Вы, наверное, забыли вставить в свой VBA-модуль определение пользовательского типа:
Public Type WordPair
original As String
translation As String
End Type
Леониду Бродскому!
Вот копия из редактора
Ответ ситемы
Compile еrror:
User-def ned type not def ned
Если можно исправьте возможные ошибки с указанием пути к таблице в программе(с:\ и т.д.). Вышеуказанная программа ak_compSleng работает корректно, однако ваши замечания справедливы, особенно важно ограничение в количестве замен. В связи с этим актуально ваше решение. Заранее благодарен!
Sub a_Zamen_tabl() 'замена слов из таблицы Public Type WordPair original As String translation As String End Type Private Function CollectDictionary(ByVal path As String) As WordPair() Dim doc As Document Dim currRow As Row Dim pair As WordPair Dim pairs() As WordPair Dim original As String Dim translation As String Set doc = Documents.Open(path, ReadOnly:=True) For Each currRow In doc.Tables(1).Rows original = currRow.Cells(1).Range.Text translation = currRow.Cells(2).Range.Text pair.original = Left(original, Len(original) - 1) pair.translation = Left(translation, Len(translation) - 2) ReDim Preserve pairs(currRow.Index) pairs(currRow.Index) = pair Next doc.Close CollectDictionary = pairs End Function Public Sub Translate() Dim documentPath As String Dim pairs() As WordPair Dim pair As WordPair Dim i As Integer documentPath = InputBox("Path to the document containing dictionary", "Dictionary") pairs = CollectDictionary(documentPath) With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = 1 To UBound(pairs) .Text = Left(pairs(i).original, Len(pairs(i).original) - 1) .Replacement.Text = pairs(i).translation .Execute Replace:=wdReplaceAll Next End With End SubИгорь, пожалуйста не дублируйте комментарии. Комментарии я все вижу, они модерируются вручную. И я их вручную же одобряю.
Игорь,
Когда вы открываете редактор Visual Basic, _весь_ код должен выглядеть точно так, как в моём (см. выше) комментарии. То есть, в приведённом вами коде лишняя первая строка:
Sub a_Zamen_tabl()
Её надо удалить. Замену слов производит макрокоманда Translate.
Леониду Бродскому!
К сожалению, все то же самое.
Compile еrror:
User-defined type not defined
Возможно есть какой-то нюанс?
Игорю.
Ну, я прямо не знаю...
Вы что-то не так делаете. Попробуйте тогда вариант без использования пользовательского типа (user-defined type).
Private Function ReadDictionaryArray(ByVal path As String) As String() 'Chitaet tablicu-slovar' iz otdel'nogo dokumenta Dim doc As Document Dim currRow As row 'dvumernyj massiv-slovar': pervaja stroka - original, vtoraja - perevod Dim pairs() As String Dim original As String Dim translation As String Set doc = Documents.Open(path, ReadOnly:=True) 'opredeljaem nachal'nuju razmernost' massiva: dve stroki, odin stolbec ReDim Preserve pairs(2, 1) For Each currRow In doc.Tables(1).Rows original = currRow.Cells(1).Range.Text translation = currRow.Cells(2).Range.Text 'uvelichivaem chislo stolbcov v massive po kolichestvu prochitannyh par slov ReDim Preserve pairs(2, currRow.Index) pairs(1, currRow.Index) = Left(original, Len(original) - 1) 'original pairs(2, currRow.Index) = Left(translation, Len(translation) - 2) 'perevod Next doc.Close 'vozvrashchaem tablicu v tochku vyzova ReadDictionaryArray = pairs End Function Public Sub TranslateA() 'zamenjaet slova v tekste na sootvetstvujushchie slova, prochitannye iz dokumenta-slovarja Dim documentPath As String Dim pairs() As String Dim i As Integer 'otkryvaem dialog dlja vvoda puti k dokumentu-slovarju documentPath = InputBox("Path to the document containing dictionary", "Dictionary") 'chitaem slovar' iz ukazannogo dokumenta pairs() = ReadDictionaryArray(documentPath) 'prosmatrivaem ves' dokument i zamenjaem slova With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = 1 To UBound(pairs, 2) .Text = Left(pairs(1, i), Len(pairs(1, i)) - 1) 'original .Replacement.Text = pairs(2, i) 'translation .Execute Replace:=wdReplaceAll Next End With End SubЛеониду Бродскому!
Все равно не получается.
В самом коде нужно вводить путь к словарю или нет?
Игорь,
Путь к словарю в коде задавать не нужно. Должно открыться диалоговое окно с запросом этого пути, вот тогда нужно его ввести.
Давайте посмотрим с самого начала, как нужно всё делать. У меня английская версия Word, так что названия буду писать, как у меня. Если у вас русская версия, надеюсь, найдёте соответствия.
Заходите в меню и выбираете Tools -> Macro -> Visual Basic Edidor. Откроется редактор кода. Слева в его окне находится окошко с заголовком Project - Normal или Project - Project. Если его нет, откройте через меню редактора кода: View -> Project Exlorer. В этом маленьком окошке найдите узел с названием Normal и нажмите на него правой кнопкой мышки. В открывшемся контекстном меню выберите Insert -> Module. В правой (бОльшей) части редактора откроется пустое окно. Скопируйте туда полностью код из моего последнего или предыдущего поста. Больше ничего в этом окне не должно быть. Запишите изменения (Save Normal). Закройте редактор кода. Откройте ваш документ, где надо заменить слова. Выберите из меню Tools -> Macro -> Macros. Окроется диалоговое окно со списком макрокоманд. Выберите в списке Translate или TranslateA в зависимости от того, из какого поста вы скопировали код. Нажмите кнопку Run. Получилось? Если нет, то напишите, какая конкретно часть инструкции не получилась и что говорит Word.
Леониду Бродскому!
Пишу на русском:
Alt+F11
Вставляю код
Сохраняю
Выхожу
Открываю Word
Alt+F8
Translate
Віполнить
ответ системы:
Compile еrror:
User-defined type not defined
в коде выделена следующая строка:
Private Function CollectDictionary(ByVal path As String) As WordPair
Извините за настойчивость, но интерес к Вашему макросу вызван возможностью динаминого корректирования словаря. Если необходим какое-то обьемное постоянное корректирование, использую указанный мною выше макрос(составляю таблицу, нехитрыми способами превращаю её в читабельный для макроса вид и блочно копирую в существующий макрос. Всё.) Надеюсь, что приведенный вами макрос заработает и у меня.
Кстати, на странице
http://forum.sysman.ru/index.php?showtopic=19957&st=0&#entry164249
приведен макрос выполняющий аналогичную задачу, однако у меня наблюдаются те же ошибки что описаны в сообщении № 3, пичем макрос запускается только при открытой таблице замен. В противном случае - ответ: файл не найден.
Леониду Бродскому!
Всё получилось. Работает прекрасно. Спасибо!!!
Я копировал код в основное окно, а не через модуль.
Возможно ли выполнить макрос в автоматическом режиме без указания пути? т.е. путь по умолчанию установлен, а если файл не найден, то - диалог.
Есть ли ограничение в размере таблицы замен?
Возьму на себя смелость подсказать. Можно сделать путь по умолчанию. Заменить процедуру Translate на ее измененный вариант:
Public Sub Translate() Dim documentPath As String Dim pairs() As WordPair Dim pair As WordPair Dim i As Integer Dim FSO As Object 'Здесь задаем имя файла по умолчанию documentPath = "c:\1.doc" Set FSO = CreateObject("Scripting.FileSystemObject") 'Если файл не существует, то показывает окно для выбора файла If Not FSO.FileExists(documentPath) Then With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False .Title = "Path to the document containing dictionary" .ButtonName = "Select" .Filters.Clear .Filters.Add "Файлы Word", "*.doc,*.docx,*.docm,*.dot,*.dotx,*.dotm" If .Show Then documentPath = .SelectedItems(1) Else Exit Sub End With End If pairs = CollectDictionary(documentPath) With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = 1 To UBound(pairs) .Text = Left(pairs(i).original, Len(pairs(i).original) - 1) .Replacement.Text = pairs(i).translation .Execute Replace:=wdReplaceAll Next End With Set FSO = Nothing End SubАлександру Витеру:
Замечательно! Как я не догадался использовать FileDialog?..
Игорю:
Это здорово, что в конце концов получилось! Значит, время потрачено не зря! Я думаю, что таблица замен оганичена только размерами доступной в компьютере памяти и быстродействием, ведь она вся должна быть прочитана в память перед началом работы. При наличии проблем можно что-нибудь придумать с несколькими проходами замены.
Александру Витеру:
Все повторяется как и в предыдущем случае.
При выполнении макроса
Compile error:
Sub or Function not defined
в коде выделена строка:
pairs = CollectDictionary(documentPath)
Возможно я опять не так устанавливаю?
Всё делаю как описано выше.
Александру Витеру:
Прошу прощения.
Всё работает.
Спасибо.
Возможно ли ускорить работу макроса?
Приведенный в шапке работает ощутимо быстрее.
И ещё.
Возможно ли решить следующую задачу:
Нужно исправить окончания ФИО в различных падежах.
ФИО на украинском языке склоняются в русской программе по правилам русского языка и соответственно окончания ломаются.
Имена и отчество я исправил с помощью приведенного выше макроса путем перечисления распространенных имен и соответствующего исправления. Окончание отчества исправил за счет буквосочетания, которое не встречается в простом тексте. С фамилией сложнее, т.к. меняются одна две буквы, и замена их затронет весь текст. Можно ли описать к примеру задачу изменения окончания в первом слове из трех подряд слов с заглавной буквы(или инициалами). Тогда можно предусмотреть возможные варианты изменения окончаний.
Леониду Бродскому!
Добрый день.
Подскажите.
Задача следующая: есть таблица, в которой находится колонка с ФИО полностью. В каждой ячейке колонки по нескольку ФИО. Нужно заменить ФИО полностью на Фамилию и инициалы. По отдельности ФИО измененяется без проблем.
Как назначить стартовое выделение и автоматический переход к следующей записи?
Игорь, а почему бы не воспользоваться стандартным поиском и заменой:
Если порядок слов Фамилия Имя Отчество:
Найти: () ( (
Заменить на: \1 \2. \3.
Если порядок слов Имя Отчество Фамилия:
Найти: ( ( ()
Заменить на: \1. \2. \3
Подстановочные знаки включены
Александру Витеру
У меня почему-то не получается.
Может быть какая-то ошибка в наборе символов?
И все-таки, как назначить для начала обработки к примеру строку или ячейку и включить её в цикл(т. е. назначить выделение аналогичное выделению мышью)
Игорь, видимо вы, непроизвольно, неправильно скопировали строку поиска. Она должна быть такой:
Почему-то при отправке сообщения добавляются пробелы после знаков больше.
Спасибо!
Всё получилось.
Хотя я не понял, почему не получалось, т.к. я не только копирровал, но и вводил выражение замены.
Подскажите пожалуйста по поводу второго вопроса(выделение аналогичное выделению мышью).
Т.е.: выделяется первая строка(ячейка), выполняется задание, переход на следующую строку, опять выполняется и т.д.
Александру Витеру.
Подскажите как решить следующую задачу с помощью макроса: в существующем документе в конце последней умещающейся строки вставить 1-ю фразу, а в начале первой строки следующего листа – 2-ю фразу, продолжить это в конце 2-го листа и.т.д., если возможно, изменить фразы. Колонтитулы не подходят.
Игорь, что такое «последняя умещающаяся строка»?
В конце последней строки на странице?
Да, в конце последней строки на каждой странице и в начале первой строки на следующей. т.е. при выполнении макроса часть последней строки с первой страницы вытесняется вставляемым текстом и соответственно передвигается на следующую страницу и т.д.
Спасибо Леониду Бродскому, Игорю и Александру Витеру.
Уважаемые, благодаря ващему диалогу, у меня все получилось буквально за пол часа.
Админу отдельное спасибо за столь полезный ресурс.
Скажите, а кто определяет жаргонность слова? У ворда есть своя библиотека жаргонных слов. Он их подчёркивает зелёной волнистой линией.
Если сам человек определяет жаргонность, то в ворде в параметрах правописания есть функция автозамены, где можно указав жаргонное слово, можно указать на какое слово его менять. Лично мы баловались и делали настройки на чужом копе таким образом, чтобы фраза "Добрый день", менялась автоматически на "Челом бью". Пользователь даже не замечал, что в письме происходила замена.
Словари. Как правило, после слова идут курсивом различные пометки, типа "жарг.".