Выделение текста от и до заданного тега (в Excel`e) - VB
Формулировка задачи:
Нужна помощь, в макросах полный ноль ;(
Например задано: 1й тег --
Текст:
Результат:
Данная тема уже обсуждалась, но для Word
Задача -- выделить жирным(курсивом) все что находиться среди двух заданных тегов.
Например задано: 1й тег --
2й тег --
Текст:
Заголовок
текст другой текст иеще выделено
.Результат:
Заголовок
текст другой текст иеще выделено
.Данная тема уже обсуждалась, но для Word
Решение задачи: «Выделение текста от и до заданного тега (в Excel`e)»
textual
Листинг программы
<font color="blue">Sub</font> ReplaceTags(OpenTag <font color="blue">As</font> <font color="blue">String</font>, CloseTag <font color="blue">As</font> <font color="blue">String</font>) <font color="blue">Dim</font> x1 <font color="blue">As</font> <font color="blue">Integer</font> <font color="blue">Dim</font> x2 <font color="blue">As</font> <font color="blue">Integer</font> <font color="blue">Dim</font> s <font color="blue">As</font> <font color="blue">String</font> x1 = InStr(ActiveCell.Text, OpenTag) x2 = InStr(ActiveCell.Text, CloseTag) <font color="blue">If</font> x1 = <font color="darkblue"><b>0</b></font> <font color="blue">Or</font> x2 = <font color="darkblue"><b>0</b></font> <font color="blue">Then</font> <font color="blue">Exit</font> <font color="blue">Sub</font> s = <font color="blue">Mid</font>(ActiveCell.Text, x1 + Len(OpenTag), x2 - x1 - Len(OpenTag)) ActiveCell.Characters(x1, Len(OpenTag)).Delete ActiveCell.Characters(x2 - Len(OpenTag), Len(CloseTag)).Delete <font color="blue">If</font> <font color="blue">Mid</font>(OpenTag, <font color="darkblue"><b>2</b></font>, Len(OpenTag) - <font color="darkblue"><b>2</b></font>) = <font color="teal">"b"</font> <font color="blue">Then</font> ActiveCell.Characters(x1, Len(s)).Font.Bold = True <font color="blue">If</font> <font color="blue">Mid</font>(OpenTag, <font color="darkblue"><b>2</b></font>, Len(OpenTag) - <font color="darkblue"><b>2</b></font>) = <font color="teal">"i"</font> <font color="blue">Then</font> ActiveCell.Characters(x1, Len(s)).Font.Italic = True <font color="blue">If</font> <font color="blue">Mid</font>(OpenTag, <font color="darkblue"><b>2</b></font>, Len(OpenTag) - <font color="darkblue"><b>2</b></font>) = <font color="teal">"sup"</font> <font color="blue">Then</font> ActiveCell.Characters(x1, Len(s)).Font.Superscript = True <font color="blue">End</font> <font color="blue">Sub</font> <font color="blue">Sub</font> StartReplaceTags() <font color="blue">Dim</font> r <font color="blue">As</font> Range <font color="blue">Dim</font> firstadress <font color="blue">As</font> <font color="blue">String</font> <font color="blue">Set</font> r = Cells.Find(What:=<font color="teal">"<*>*<!--*-->"</font>, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) <font color="blue">If</font> <font color="blue">Not</font> r <font color="blue">Is</font> <font color="blue">Nothing</font> <font color="blue">Then</font> firstadress = r.Address <font color="blue">Do</font> r.Activate ReplaceTags <font color="teal">"<b>"</b></font><b>, <font color="teal">"</font></b><font color="teal">"</font> ReplaceTags <font color="teal">"<i>"</i></font><i>, <font color="teal">"</font></i><font color="teal">"</font> ReplaceTags <font color="teal">"<sup>"</sup></font>, <font color="teal">""</font> <font color="blue">Set</font> r = Cells.FindNext(r) <font color="blue">If</font> r <font color="blue">Is</font> <font color="blue">Nothing</font> <font color="blue">Then</font> <font color="blue">Exit</font> <font color="blue">Do</font> <font color="blue">Loop</font> <font color="blue">While</font> r.Address <> firstadress <font color="blue">End</font> <font color="blue">If</font> <font color="blue">End</font> <font color="blue">Sub</font>
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д