Оптимальный способ извлечения данных из строки в VBA

Question

Привет всем, как и многие, я трансформирую свое время covid в программирование. Ковидинг? :)

Мне нужно извлечь подстроки из строки с помощью VBA в Excel, и я буду признателен за предложения по доступным решениям. Я думал, что регулярное выражение будет путем к go, но на самом деле я довольно не уверен, так как я довольно незнаком с регулярным выражением, и это, возможно, для него сложно. Возможно, есть какое-то гораздо более простое решение, о котором я не знаю, любые предложения очень ценю. Я создаю книгу Excel для помощи переводчикам, которую пожертвую их сообществу. Шаблон следующий:

• перед <</li>
• между> и <</li>
• текст после>

Примеры строк: (без первая и последняя кавычки):

Пример 1:

"You are currently viewing a stripped down version of our content. <a href=\"{1}\">View the full version</a> with proper formatting."

• строка 1 = "You are currently viewing a stripped down version of our content. "
• строка 2 = "View the full version"
• строка 3 = " with proper formatting."

Пример 2:

"<b>Private</b> Only you will be able to view this event. (Registered Users Only)."

• строка 1 = "Private"
• строка 2 = " Only you will be able to view this event. (Registered Users Only)."

Пример 3:

 " This day does not have any events associated with it.<p><a href=\'calendar.php?action=addevent&amp;calendar={1}&amp;day={2}&amp;month={3}&amp;year={4}\'>Post an Event</a>.</p>"

• строка 1 = "This day does not have any events associated with it."
• строка 2 = "Post an Event"
• строка 3 = "."

Пример 4: (Этот пример является самым большим из тех, что я видел )

"<p><br />[list]<br />[*]List Item #1<br />[*]List Item #2<br />[*]List Item #3<br />[/list]<br /><ul><li>List item #1</li><li>List item #2</li><li>List Item #3</li>"

• строка 1 = "[list]"
• строка 2 = "[*]List Item #1"
• строка 3 = "[*]List Item #2"
• строка 4 = "[*]List Item #3"
• строка 5 = "[/list]"
• строка 6 = "List item #1"
• строка 7 = "List item #2"
• строка 8 = "List item #3"

Будем признательны за любые предложения. * 1 098 *

Изменить: добавление еще нескольких образцов

<span title=\"{1}\">Today</span>

<span title=\"{1}\">Yesterday</span>

<span title=\"{5}{6}\">{1}{2} {3} {4}</span>

You are currently using <strong>{1}</strong>.

<br /><br />You are encouraged to register; once you register you will be able to post messages, set your own preferences, and maintain a profile.

<br /><br />Some of the features that generally require registration are subscriptions, changing of styles, accessing of your Personal Notepad and emailing forum members.

<br /><br />Cookies are small text documents stored on your computer; the cookies set by this forum can only be used on this website and pose no security risk.

<br /><br />Cookies on this forum also track the specific topics you have read and when you last read them.

<p><br />[url]http://www.example.com/[/url]<br />&nbsp;&nbsp;&nbsp;<a href=\"http://www.example.com/\">http://www.example.com/</a>

<p>[url=http://www.example.com/]Example.com[/url]<br />&nbsp;&nbsp;&nbsp;<a href=\"http://www.example.com/\">Example.com</a>

<p>[email]example@example.com[/email]<br />&nbsp;&nbsp;&nbsp;<a href=\"mailto:example@example.com\">example@example.com</a>

Answer 1

Если исходные строки находятся в столбце A:

Sub Demo()
Dim i As Long, r As Long, c As Long, StrIn As String, StrOut As String
With ActiveSheet
  For r = 1 To .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    StrIn = ActiveSheet.Range("A" & r).Text: c = 1
    For i = 0 To UBound(Split(StrIn, ">"))
      If Split(StrIn, ">")(i) <> "" Then
        If Split(Split(StrIn, ">")(i), "<")(0) <> "" Then
          c = c + 1
          .Cells(r, c).Value = Split(Split(StrIn, ">")(i), "<")(0)
        End If
      End If
    Next
  Next
End With
End Sub

Answer 2

Этот подход демонстрирует несколько шагов для обработки массива, включая более новую FilterXML() функцию (доступна с 2013 +) :

Функция RemoveHTML()

Выполняет следующие шаги:

• a) пометить html теги неиспользуемым символом, например, «$» через Split() функцию
• b) удалить html теги через Filter() функцию
• c) удалить пустые элементы массива через FilterXML() функцию - (доступно в версиях 2013 +)
• d) вернуть "плоский" одномерный массив как результат функции через Application.Transpose()

Function RemoveHTML(ByVal mystring)
    Dim items
'a) mark html tags by unused character, e.g. "$"
    items = Split(Replace(mystring, ">", "$<"), "<") ' mark html tags by $
'b) remove html tags via Filter()
    items = Filter(items, "$", False)                           ' remove items marked by $
'c) remove empty array items via FilterXML()
    items = WorksheetFunction.FilterXML("<t><s>" & Join(items, "</s><s>") & "</s></t>", "//s[not(.='')]")
'd) return "flat" 1-dim array as function result
    RemoveHTML = Application.Transpose(items)                   ' return "flat" 1-dim array
End Function

Пример вызова

Предполагает начало данных в ячейке A2 и результаты в соседних столбцах:

Sub ExampleCall()
With Sheet1                                ' the project's sheet Code(Name), e.g. Sheet1
'[0]define data range
    Dim rng As Range
    Set rng = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
'[1]assign data in column A to variant 2-dim array
    Dim data: data = rng
'[2]loop through strings
    Dim i As Long
    For i = 1 To UBound(data)
    'a) remove html tags
        Dim items: items = RemoveHTML(data(i, 1))    ' << help function RemoveHTML()
    'b) write results to adjacent columns
        .Range("B1").Offset(i).Resize(Columnsize:=UBound(items)) = items
    Next
End With
End Sub