Быстрый поиск и замена в Word?

Question

[Анатолий Сидоров]

Добрый день!
Если документ на ~350 страниц. В конце документа(только на последних страницах) есть уникальные метки типа p***p, *** - соответствует какому либо значению из словаря. Стоит задача заменить эти метки на их эквиваленты из словаря и поменять их цвет на черный.
Вот пример написанного:

For Each Key In dic.Keys
	newText = dic.Item(Key)

	objWrd.Selection.EndKey 'т.к. странице лежат в конце, начинаем поиск оттуда
	With objWrd.Selection.Find
		.ClearFormatting
		.Replacement.ClearFormatting
		.Text = Key
		.Replacement.Text = newText
		.Forward = True
		.Wrap = 2
		.Format = False
		.MatchCase = False
		.MatchWholeWord = False
	End With
	
	objWrd.Selection.Find.Execute , , , , , , , , , , 1
	objWrd.Selection.Font.Color = -587137025
Next

Работает, но очень медленно, на рабочей машине 10-15 минут.
Какие могут быть варианты ускорения работы поиска и замены?

Заранее спасибо.

Comments

[h8nor]

VBA или Vbscript?

Answer 1

[h8nor]

Вероятно, проблема в использовании объекта Selection. Код для VBA:

Option Explicit
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789

Sub Replacement_tags()
  Dim Content_Find As Find ' Объект Find (в VBScript переменные объявляются без указания типа)
  Const wdFindContinue = 2 ' для VBScript
  Const wdReplaceAll = 1 ' для VBScript
  
  ' Set objWrd = CreateObject("Word.Application") ' В MS Word объявлять не нужно
  ' в VBScript всё равно придётся открывать файл, так что objDoc = objWrd.ActiveDocument
  ' Set objDoc = objWrd.Documents.Open(Filename:="C:\FullName.doc")
  Set Content_Find = ActiveDocument.Content.Find ' в VBScript - objDoc.Content.Find
  
  With Content_Find ' Найти метку
    .ClearFormatting: .Replacement.ClearFormatting ' Очистить формат
    .MatchWildcards = False ' ВАЖНО! Отключить Подстановочные знаки
    .Replacement.Font.Color = wdColorAutomatic ' wdColorAutomatic = -587137025
    
    .Text = "p***p": .Replacement.Text = "newText"
    .Execute2007 Forward:=True, Replace:=wdReplaceAll, Wrap:=wdFindContinue
  End With

  ' Подсветить ".Text" в документе Word 2007+ (визуальная отладка)
  With Content_Find ' Отменяется после метода "Execute" или "ClearHitHighlight"
    .Parent.HomeKey wdStory ' wdStory = 6
    .HitHighlight .Text, wdColorTan ' wdColorTan = &H99CCFF
  End With
End Sub

Думаю, что метод .Selection.EndKey не нужен, т.к. в вашем примере указана замена по всему тексту (.Replace = 1), а поиск начинается с позиции курсора, т.е. сначала. Цикла поиска по тексту нет, так что .Wrap можно не использовать.

Вариант проще: можно перед заменой отключить обновление экрана приложения objWrd.ScreenUpdating = False.