Макрос на замену каждого третьего слова в тексте на код EQ - VBA
Формулировка задачи:
Здравствуйте! Помогите, пожалуйста, создать макрос для замены каждого третьего слова в тексте на код EQ. Вот собственно в чем вопрос:
Исходный текст:
Измененный текст:
Как я это делаю. В ручную выполняю макрос:
Однако громадные возможности компьютеров оказали влияние не только на технические аспекты этого вида деятельности.
Однако громадные {eq возможности} компьютеров оказали {eq влияние} не только {eq на} технические аспекты {eq этого} вида деятельности.
Задача: автоматизировать макросом процесс замены слов в тексте на поле вида {eq "каждое третье слово в тексте"}.
Должно получиться, что в макросе выполняется 1)Поиск в тексте каждого третьего слова 2) Замена этого слова на поле вида {eq "слово"}.
Визуально, в тексте не видно поля {eq любое слово} выглядит это так:
На деле это выглядит вот так:
Или такой вариант:
Макрос, должен уметь:
-определять границу каждой второй пары слов;
-иметь свою базу слов, для каждого третьего слова (для вашего примера: возможности; влияние; на; этого);
-вставлять после каждого второго слова, Поле EQ (Текст из базы макроса).
Какие будут идеи?
Решение задачи: «Макрос на замену каждого третьего слова в тексте на код EQ»
textual
Листинг программы
Sub EQScriptFM() Dim w As Range, j&, s$, nf0&, nf&, nw&, d0#, d#, d00#, r As Range Application.ScreenUpdating = False d00 = Now d0 = d00 + #12:00:01 AM# Set w = ActiveDocument.Range nw = w.End With w.Find .ClearFormatting .Text = "<*>*<*>*<*>" ' .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With While w.Find.Execute Set r = ActiveDocument.Range(w.Words.Last.Start, w.End) s = r.Text With w.Fields.Add(Range:=r, Type:=wdFieldEmpty) .Code.Text = "eq " & Trim$(s) End With nf = nf + 1 d = Now If d >= d0 Then Application.StatusBar = (w.Start - 5 * nf) * 100 \ nw & "% " & nf - nf0 & " полей/сек" DoEvents nf0 = nf d0 = d + #12:00:01 AM# End If w.Collapse wdCollapseEnd Wend Application.ScreenUpdating = True d = Int((d - d00) * 86400) If d = 0 Then d = 1 s = nf & " полей за " & d & " сек, " & Format(nf / d, "0.0 полей/сек") MsgBox s, vbInformation Debug.Print s End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д