Макрос VBA для удаления всего до и после тега <div>

Question

Я создаю отчет, в котором есть столбец с множеством ячеек, в которых HTML-теги есть почти в каждом поле. Я пытаюсь создать макрос VBA, который удалит некоторые теги HTML из этого столбца.

Итак, в одной ситуации у меня есть:

<h1>text text.........text</h1>
<p>text text.........text</p>
<div class="Take"> text text.........text </div>
<p>text text.........text</p>
<div class="Found">
 <div class="Deficient">
 <p>text text.........text</p>
 <p>text text.........text</p>
<img>....</img>

Я только перечислил только некоторые теги HTML, но есть и другие.

Я хочу извлечь только содержимое между тегами <div class=...> и сохранить сам тег div. Остальные должны быть удалены

<h1>text text.........text</h1>
<div class="Take"> text text.........text </div>
<div class="Found"> text text.........text </div>
<div class="Deficient"> text text.........text </div>

Кто-нибудь знает способ сделать это?

Answer 1

Вы можете просто использовать Excel найти и заменить.

Найдите тег, например <h1> и замените его ничем (пробел / пробел). Затем сделайте то же самое с закрывающим тегом '', который покинет контент.

НАПРИМЕР

<h1>My content</h1>

станет

My content

Для других тегов, где вам нужно удалить тег и контент, используйте подстановочный знак * .

Найдите <p>*</p> и замените его пробелом! Это удалит всю запись.

А для самозакрывающихся вкладок, таких как IMG, вы можете сделать <img*/>

Answer 2

Это должно вытащить его, замените msgbox на то место, где вы хотите, чтобы значение печаталось, и отрегулируйте диапазон соответствующим образом. Если это не конкретные cells вы можете попробовать поискать по row .

Sub test()

Dim c As Range
Dim sFound As String
Dim sValue As String
Dim i As Long
Dim j As Long
For Each c In Range("A:A")
    If Not c.Find("<div class") Is Nothing Then
       sFound = c.Value
       i = InStr(sFound, ">")
       j = InStr(sFound, "</div")
       sValue = Mid(sFound, i + 1, j - i - 1)

       MsgBox (sValue)

    End If
Next c

End Sub

например, вместо msgbox(svalue) вы могли бы пойти с

dim k as integer
k=1

worksheets("sheet2").cells(k,1) = svalue
k=k+1

переместить его на другой лист.

Если у вас есть какой-то <div class котором нет </div> или чего-то еще, добавьте on error resume next