Извлечь все слова Word с разделителями <b>...</b>

Я попытался смоделировать это в Excel. пожалуйста, проверьте мой образец решения ниже.

Sub test()

    Dim testString As String
    Dim startPos As Integer
    Dim endPos As Integer
    Dim resultString As String
    Dim str As String

    testString = "<b>buat</b> <i>v</i> <b>1</b> kerjakan; lakukan; <b>2</b> bikin;<br>--<b> cendol</b>"


    'get the position of start tag
    startPos = InStr(1, testString, "<b>") + 3

    'get the position of end tag
    endPos = InStr(startPos, testString, "</b>")


    Do While Len(testString) > 1

        'check if the start pos and end pos is correct
        If startPos > 0 And endPos > startPos Then

            'get the value in between the start tag and end tag
             str = Mid(testString, startPos, endPos - startPos)

             resultString = resultString + str + ","

             'remove the value retrieved from the original string
             testString = Mid(testString, endPos + 4)

             startPos = InStr(1, testString, "<b>") + 3
             endPos = InStr(startPos, testString, "</b>")

        End If

    Loop

End Sub

Попробуй это

Sub Test()
Dim objReg      As Object
Dim objMatches  As Object
Dim match       As Object
Dim s           As String
Dim i           As Integer

s = "<b>buat</b> <i>v</i> <b>1</b> kerjakan; lakukan; <b>2</b> bikin;<br>--<b> cendol</b> "
Set objReg = CreateObject("VBScript.RegExp")

With objReg
    .IgnoreCase = False
    .Global = True
    .Pattern = "<b>(.*?)</b>"
    Set objMatches = .Execute(s)
End With

For Each match In objMatches
    For i = 0 To match.Submatches.Count - 1
        Debug.Print Trim(match.Submatches.item(i))
    Next i
Next match

Set objReg = Nothing
End Sub

Есть очень простой способ сделать это с помощью объекта HTMLDocument:

В своем VB Editor перейдите к Tools>References и выберите Microsoft HTML Object Library.

Затем вы можете использовать следующий код:

Sub extract()

Dim doc As New HTMLDocument 'Declare and create an object of type HTMLDocument
Dim item As HTMLObjectElement 'Declare an object of type HTMLObjectElement. We will use this to loop through a collection of HTML elements

doc.body.innerHTML = "<b>buat</b> <i>v</i> <b>1</b> kerjakan; lakukan; <b>2</b> bikin;<br>--<b> cendol</b> " 'Assign your HTML code as a string in doc body

For Each item In doc.getElementsByTagName("b") 'Loop through all the <b></b> elements in doc
    Debug.Print item.innerText 'print the text contained in <b></b> element. This will show up in your immediate window
Next item

End Sub

Альтернатива с использованием XML DomDocument

При анализе строки HTML кажется очевидным использование структур объекта документа, как в HTMLDocument или в ►XML. Вот почему я демонстрирую еще один подход для полноты картины и в дополнение к действительному решению @СтавросДжон (которое использует более мягкое HTMLDocument, не требующее правильного формирования, как XML):

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

Sub ExtractViaXML()
  Dim html$, myArray()
  html = "<b>buat</b> <i>v</i> <b>1</b> kerjakan; lakukan; <b>2</b> bikin;<br>--<b> cendol</b> "
  myArray = getTokens(html, "b")                              ' assign findings to array via function getTokens()
  Debug.Print UBound(myArray) + 1 & " token(s) found: " & Join(myArray, ", ")  ' display results
End Sub

Основная функция getTokens()

Function getTokens(ByVal html$, Optional myTag$ = "b") As Variant()
' Purpose: isolate "<b>"-Tags (default value) out of html string and return found tokens as variant array
' Note:    creates temporary XML DOMDocument (late bound MSXML2 reference)
  Dim XmlString$
  XmlString = wellformed("<?xml version = ""1.0"" encoding = ""utf-8""?><tokens>" & html & "</tokens>")

  With CreateObject("MSXML2.DOMDocument.6.0")
      .ValidateOnParse = True: .Async = False
      If .LoadXML(XmlString) Then                              ' load xml string
          Dim myNodeList As Object
          Set myNodeList = .DocumentElement.SelectNodes(myTag) ' set node list to memory
          Dim i&, ii&, arr()
          ii = myNodeList.Length - 1                           ' calculate upper boundary of zero-based array
          If ii > -1 Then ReDim arr(ii)                        ' (re)dimension variant array arr()
          For i = 0 To ii                                      ' loop through node list
              arr(i) = myNodeList.item(i).Text                 ' assign each found text content to array
          Next i
          If ii = -1 Then arr = Array("**Nothing found**")     ' provide for zero findings
          getTokens = arr                                      ' return 0-based 1-dim array with found tokens
      Else: ShowParseError (.ParseError)                       ' optional: display possible error message
      End If
  End With
End Function

Вспомогательные функции

XML требует структуру узла хорошо сформированный с открывающими и закрывающими тегами или, тогда как HTML более снисходителен, например. одиночные разрывы строк (<br>). Поэтому я добавил простую функцию wellformed() в излечивать, такую ​​проблему, препятствующую успешной загрузке. Кроме того, я демонстрирую использование дополнительной процедуры ShowParseError для локализации (других) возможных ошибок загрузки, которую вы можете использовать в качестве дополнения к любой функции .load или .loadXML.

Function wellformed$(ByVal s$)
' Purpose: force a wellformed version of line breaks in html/xml string ("<br/>")
' Note:    unclosed tags like <br> only would prevent a successful load of the xml document
  wellformed = Replace(Replace(s, "</br>", "<br>"), "<br>", "<br/>")
End Function

Sub ShowParseError(pe As Object)
' Purpose: display possible parse error
' Note:    localizes error occurrence also by indicating position
        Dim ErrText$
        With pe
           ErrText = "Load error " & .ErrorCode & " xml file " & vbCrLf & _
           Replace(.URL, "file:///", "") & vbCrLf & vbCrLf & _
          .reason & _
          "Source Text: " & .srcText & vbCrLf & vbCrLf & _
          "Line No.:    " & .Line & vbCrLf & _
          "Line Pos.: " & .linepos & vbCrLf & _
          "File Pos.:  " & .filepos & vbCrLf & vbCrLf
        End With
        MsgBox ErrText, vbExclamation
End Sub

Это можно сделать с помощью функции рабочего листа FILTERXML, если у вас Excel 2013+.

Сначала вам нужно преобразовать строку в «правильно сформированный» XML, заключив ее во внешний тег и закрыв несопоставленный тег <br>:

"<t>" & $A$1 & "</br></t>"

Тогда это просто вопрос использования Xpath, который вернет все нужные теги:

FILTERXML("<t>" & $A$1 & "</br></t>","//b")

Оборачивая это в функцию INDEX, вы можете извлекать подстроки по одной:

Полная формулавведено в A3 и заполнено

=IFERROR(INDEX(FILTERXML("<t>" & $A$1 & "</br></t>","//b"),ROWS($1:1)),"")

Я пробовал что-то другое, с разделением, объединением и повторным разделением, а также зацикливанием через массив. Я набрал текст <b>buat</b> <i>v</i> <b>1</b> kerjakan; lakukan; <b>2</b> bikin;<br>--<b> cendol</b> в ячейку A1:

Sub Macro1()
Dim MyWords As Variant
Dim i As Long
Dim MyDelimiter As String
Dim MyLen As Byte

MyDelimiter = "||" 'Choose 1 not common delimiter
MyLen = Len(MyDelimiter)

MyWords = Split(Join(Split(Range("A1").Value, "<b>"), MyDelimiter), "</b>")

For i = 0 To UBound(MyWords) Step 1
    Debug.Print Mid(MyWords(i), InStr(1, MyWords(i), MyDelimiter) + MyLen, 99) 'Increase 99 if you are sure there will be longer texts between tags <b>..</b>
Next i

Erase MyWords
End Sub

Я получаю это: