Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удалить мусор их HTML-тегов, но оставить нужное
 
#1
22.05.2018 10:08:23
Есть макрос, который удаляет все атрибуты в тегах:
Код
Sub ЧисткаHTML()    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Columns(31).Cells
        cell = HTML_DeleteAttributes(cell)
    Next cell
End Sub
 
Function HTML_DeleteAttributes(ByVal txt$)
    On Error Resume Next
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(<[A-Za-z1-6]+)[^<>]*(>)"
        txt$ = .Replace(txt$, "$1$2")
        .Pattern = ">\s*<"
        txt$ = .Replace(txt$, "><")
    End With
    HTML_DeleteAttributes = txt$
End Function

Однако в моем случае необходимо оставлять значения rowspan и colspan у тега <td>.

Например:
из этого тега <td style=width:115.55pt,border:solid windowtext 1.0pt, mso-border-alt:solid windowtext .5pt,padding:0cm 5.4pt 0cm 5.4pt rowspan=2 width=154 valign=top> после удаления всего лишнего "мусора" должно получиться значение  <td rowspan=2>.

Варианты могут быть такие:
1. в теге td присутствует только rowspan
2. в теге td присутствует только colspan
3. в теге td присутствует  и rowspan и colspan.
Они располагаются внутри тега хаотично, в разных местах - могут быть вначале, середине или конце.  

Например:
<td colspan=3 style=width:115.55pt,border:solid windowtext 1.0pt, mso-border-alt:solid windowtext .5pt,padding:0cm 5.4pt 0cm 5.4pt rowspan=2 width=154 valign=top>.
В этом случае на выходе должно получиться так: <td colspan=3 rowspan=2>

Мне давали ссылку на https://www.planetaexcel.ru/techniques/7/4844/
Однако с программированием у меня туго, теорию там прочитал, но прописать в этом макросе эти исключения не могу:(

Пример одной позиции в файле прикрепляю.
Таких позиций у меня порядка 10 тыс штук.

Буду рад за помощь.
 
 
 
#2
22.05.2018 11:04:03
Нашел частичное решение тут:
https://ru.stackoverflow.com/questions/315050/%D0%9E%D1%87%D0%B8%D1%81%D1%82%D0%B8%D1­%82%D1%8C-%D1%8...

Необходимо правильно прописать выражение:
$pattern = '/<([a-z][a-z0-9]*)++(?:( rowspan="\d+")|(?:[^>]?(?=( rowspan="\d+")?))++)[^>]*?(\/?)>/i';

Но не получается вклинить его в сам макрос.
 
 
 
#3
22.05.2018 14:17:20
Может есть вариант реализовать это при помощи замен?

Ctrl+H
и после заменить <td *colspan=2*> на  <td colspan=2> и так для каждого rowspan и colspan?
Значения у меня могут меняться от 2 до 13 (у обоих).

Так пробовал, но отчего-то принудительно удаляет все, что находится до тега <td ... colspan=...>

Где же ошибка?
 
 
 
#4
22.05.2018 16:25:37
Доброе время суток.
Так и не удалось подавить жадность в случае если для шаблона подбора установить ноль или один (в этом случае всегда, эта падла и в js тоже, подхватывает только один подбор). Вариант для собственно ручного допиливания.
Код
Public Sub repRowspanColSpan()
    Const basePattern As String = "(<td)[^>]*?( (?:colspan|rowspan)=\d+)[^>]*?(>)"
    Const twoPattern As String = "(<td)[^>]*?( (?:colspan|rowspan)=\d+)[^>]*?( (?:colspan|rowspan)=\d+)[^>]*?(>)"
    Dim pReg As Object, pItem As Object
    Dim resStr As String, findStr As String, replaceStr As String
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Global = True: pReg.IgnoreCase = True
    pReg.Pattern = basePattern
    resStr = ActiveCell.Value
    For Each pItem In pReg.Execute(resStr)
        findStr = pItem.Value
        pReg.Pattern = twoPattern
        If pReg.Test(findStr) Then
            replaceStr = pReg.Replace(findStr, "$1$2$3$4")
        Else
            pReg.Pattern = basePattern
            replaceStr = pReg.Replace(findStr, "$1$2$3")
        End If
        resStr = Replace$(resStr, findStr, replaceStr)
    Next
    Debug.Print resStr
End Sub

Успехов
P. S. У вас там [td] может быть и без атрибутов colspan/rowspan, но и с прочим набором атрибутивной шелухи, но думаю с этим вы и сами справитесь.
 
 
 
#5
22.05.2018 19:50:35
разбивем  исхожный текст на <td...>, потом в каждом <td...> ищем "(row|col)span=\d+" м забираем те из <td...>, в которых нашлось row или col span
Код
Function RowColSpan$(s$)
  Dim re, m, mrc, i&, j&
  Set re = CreateObject("VBscript.RegExp"):  re.Global = True:  re.Pattern = "<td[^>]+>"
  If re.test(s) Then
    Set m = re.Execute(s): re.Pattern = "(row|col)span=\d+"
    For i = 0 To m.Count - 1
      If re.test(m(i)) Then
        Set mrc = re.Execute(m(i))
        RowColSpan = RowColSpan & vbLf & "<td"
        For j = 0 To mrc.Count - 1: RowColSpan = RowColSpan & " " & mrc(j): Next
        RowColSpan = RowColSpan & ">"
      End If
    Next
    RowColSpan = Right(RowColSpan, Len(RowColSpan) - 1)
  End If
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#6
23.05.2018 10:46:50
Благодарю тех, кто откликнулся.

Ігор Гончаренко, спасибо Вам. Но я наверное не совсем правильно выразился:( При очистке тегов от мусора нужно заменять теги td  с "мусором" на td "без мусора" с сохранением rowspan и colspan(при наличии).

т.е. сейчас при применении функции для данной строки:
Код
<p>
<table border=1>
<tr>
<td rowspan=2 style=width:115.55pt,border:solid windowtext 1.0pt, mso-border-alt:solid windowtext .5pt,padding:0cm 5.4pt 0cm 5.4pt width=154 valign=top>
<p>Система органного класса</p>
</td>
<td colspan=3 style=width:346.7pt,border:solid windowtext 1.0pt, border-left:none,mso-border-left-alt:solid windowtext .5pt,mso-border-alt: solid windowtext .5pt,padding:0cm 5.4pt 0cm 5.4pt width=462 valign=top rowspan=3>
<p>Частота побочных реакций </p>
</td>
</tr>
<tr style=mso-yfti-irow:1><td style=width:115.55pt,border-top:none,border-left: none,border-bottom:solid windowtext 1.0pt,border-right:solid windowtext 1.0pt, mso-border-top-alt:solid windowtext .5pt,mso-border-left-alt:solid windowtext .5pt, mso-border-alt:solid windowtext .5pt,padding:0cm 5.4pt 0cm 5.4pt width=154 valign=top>
<p>Часто</p>
<p>(1/100 и <,1/10)</p>
</td>
<td style=width:115.55pt,border-top:none,border-left: none,border-bottom:solid windowtext 1.0pt,border-right:solid windowtext 1.0pt, mso-border-top-alt:solid windowtext .5pt,mso-border-left-alt:solid windowtext .5pt, mso-border-alt:solid windowtext .5pt,padding:0cm 5.4pt 0cm 5.4pt width=154 valign=top>
<p>Нечасто</p>
<p>(1/1000 и <,1/100)</p>
....

получается

Код
<td rowspan=2> <td colspan=3 rowspan=3>
Хотя должно получиться так:
Код
<p>
<table>
<tr>
<td rowspan=2>
<p>Система органного класса</p>
</td>
<td colspan=3>
<p>Частота побочных реакций </p>
</td>
</tr>
<tr>
<td>
<p>Часто</p>
<p>(1/100 и <,1/10)</p>
</td>
<td>
<p>Нечасто</p>
<p>(1/1000 и <,1/100)</p>
.....

Андрей VG, Вам тоже большое спасибо за приведенный код, буду разбираться.
 
 
 
#7
23.05.2018 12:42:26
Еще вариант паттерна для RegExp:
Код
(<(?:td|tr))[^>]*?((?: colspan| rowspan)\s*=\s*\S+)?[^>]*?((?: colspan| rowspan)\s*=\s*\S+)?[^>]*?(>)
In GoTo we trust
 
 
 
#8
23.05.2018 18:59:05
Ура! Получается!!!:)

tolstak, Вы гений! Спасибо Вам большое!!!
 
 
 
#9
23.05.2018 19:00:32
Всего-то, что нужно было, чтобы получить желаемое - отписаться в теме. А Вы по сети пошли...
Не забудьте отметить на StakOverflow
 
 
 
#10
23.05.2018 21:09:51
Сделано!  :)  
 
 
 
Страницы: 1
Наверх