从VBA中的字符串中提取数据的最佳方法

Question

大家好，和许多人一样，我正在将我的新冠病毒时间转化为编码。共病？ :)

我需要在 Excel 中使用 VBA 从字符串中提取子字符串，并希望获得有关可用解决方案的建议。我认为正则表达式将是要走的路，但实际上我很不确定，因为我对正则表达式相当不熟悉，这可能很复杂。也许有一些我不知道的更简单的解决方案，非常感谢任何建议。

字符串源自开源 mybb 论坛的英文文件。我正在创建一个 Excel 工作簿来帮助翻译人员，我将把它捐赠给他们的社区。​​p>

需要的是移除 html，并将每个子字符串放置在相邻的单元格中。模式是：

• 之前
• 在 > 和 之间
• 后面的文字>

字符串示例（不带首尾引号）：

示例 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"

任何建议将不胜感激。

编辑：添加更多示例

<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) 通过Filter() 函数删除html标签
• 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