Задача (поиска и замены)

Программирование на Visual Basic for Applications
Ghost Mouse
Начинающий
Начинающий
 
Сообщения: 1
Зарегистрирован: 19.11.2013 (Вт) 10:18

Задача (поиска и замены)

Сообщение Ghost Mouse » 19.11.2013 (Вт) 10:22

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

Пример : У меня есть серый 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

Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: Bing-бот и гости: 3

    TopList