Выделение текста от и до заданного тега (в Excel`e) - VB

Узнай цену своей работы

Формулировка задачи:

Нужна помощь, в макросах полный ноль ;(

Задача -- выделить жирным(курсивом) все что находиться среди двух заданных тегов.


Например задано: 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>


ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 4 из 5
Похожие ответы