1

Тема: Макрос

подскажите, пожалуйста, что можно сделать для замены в документе записей типа:

Пример :     У меня есть серый Cat  и большая DOG из fusion reactor возле его Clean будки

Результат : У меня есть серый Кот и большая Собака из ядерного реактора возле его  smile чистой будки .

(Можно реализовать как нибудь быстрее , более 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

2

Re: Макрос

По-моему, оба варианта вполне приемлемые.
Что касается скорости обработки, то макросы VBA вообще работают медленно с большими файлами. Тут, как мне кажется, ничего не поделаешь.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.