Тема: Макрос
подскажите, пожалуйста, что можно сделать для замены в документе записей типа:
Пример : У меня есть серый Cat и большая DOG из fusion reactor возле его Clean будки
Результат : У меня есть серый Кот и большая Собака из ядерного реактора возле его 
чистой будки .
(Можно реализовать как нибудь быстрее , более 1000 зап обрабатываются , где то 40 сек ) , есть реализация через массив (но 'тоже тормозит , плюс придётся вручную 1000 зап (сейчас 390 зап и лагает при замене)) , или реализация поиска строчно .
1-ый Вариант
Sub engtorus (sin$, sout$)
Selection.EndKey wdStory
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sin$
.Replacement.Text = sout$
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Sub Bot()
engtorus "DOG", "Собака"
engtorus "Cat", "Кот"
engtorus "fusion reactor", "термоядерный реактор"
engtorus "Clean", "Чистой"2-ой Вариант
Sub qwe()
Dim str As Range
Dim FindText As Variant
Dim ReplaceText As Variant
Dim i As Long
Set str = ActiveDocument.Range
FindText = Array("DOG", "Сat ", "fusion reactor", "Clean")
ReplaceText = Array("Собака", "Кот", "термоядерный реактор", "чистой")
With str.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindsTextop
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True
For i = LBound(FindText) To UBound(FindText)
.Text = FindText(i)
.Replacement.Text = ReplaceText(i)
.Execute Replace:=wdReplaceAll
Next i
End With
End Sub