在 VBA (excel) 中返回正则表达式匹配答案

【问题标题】：Returning a regex match in VBA (excel)在 VBA (excel) 中返回正则表达式匹配
【发布时间】：2021-10-23 07:15:48
【问题描述】：

我正在尝试为 excel 2010 编写一个函数，该函数将获取一个非结构化文本单元格，查找称为 sdi 值的内容，如果找到，则返回该数字。 sdi 值将显示为 sdi ####。我想要的是返回 sdi 和它后面的具体数字，所以如果单元格包含“一些文本 sdi 1234 一些更多的文本”，该函数将返回 sdi 1234。

这是我的功能：

Function SdiTest(LookIn As String) As String
  Dim temp As String
  Dim STA As Object
  temp = ""

  Set SDI = CreateObject("VBScript.RegExp")
  SDI.IgnoreCase = True
  SDI.Pattern = "sdi [1-9]*"
  SDI.Global = True

  If SDI.Test(LookIn) Then
    temp = SDI.Execute(LookIn)
  End If

  SdiTest = temp
End Function

如果没有 sdi 编号，它永远不会进入 if 语句并忠实地返回空字符串。如果有 sdi 号码，我会得到 #VALUE！

我错过了什么？

是的，VBScript 已启用。此外，我发现在 VBA 中使用正则表达式令人沮丧，并且很难在网上找到有用的信息。我们将不胜感激提供优质在线资源的链接。

谢谢

【问题讨论】：

标签： regex excel vba

【解决方案1】：

您需要访问匹配项才能获得 SDI 编号。这是一个可以做到这一点的函数（假设每个单元只有 1 个 SDI 编号）。

对于正则表达式，我使用了“sdi 后跟一个空格和一个或多个数字”。你有“sdi 后跟一个空格和零个或多个数字”。您可以简单地将我的模式中的 + 更改为 * 以恢复到原来的状态。

Function ExtractSDI(ByVal text As String) As String

Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.pattern = "(sdi \d+)"
RE.Global = True
RE.IgnoreCase = True
Set allMatches = RE.Execute(text)

If allMatches.count <> 0 Then
    result = allMatches.Item(0).submatches.Item(0)
End If

ExtractSDI = result

End Function

如果一个单元格可能有多个您要提取的 SDI 编号，这是我的 RegexExtract 函数。您可以传入第三个参数来分隔每个匹配项（如逗号分隔），然后在实际函数调用中手动输入模式：

Ex) =RegexExtract(A1, "(sdi \d+)", ", ")

这里是：

Function RegexExtract(ByVal text As String, _
                      ByVal extract_what As String, _
                      Optional seperator As String = "") As String

Dim i As Long, j As Long
Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.pattern = extract_what
RE.Global = True
Set allMatches = RE.Execute(text)

For i = 0 To allMatches.count - 1
    For j = 0 To allMatches.Item(i).submatches.count - 1
        result = result & seperator & allMatches.Item(i).submatches.Item(j)
    Next
Next

If Len(result) <> 0 Then
    result = Right(result, Len(result) - Len(seperator))
End If

RegexExtract = result

End Function

*请注意，我已从 RegexExtract 中取出“RE.IgnoreCase = True”，但您可以将其重新添加，如果您愿意，甚至可以将其添加为可选的第四个参数。

【讨论】：

TheoRose，不客气。如果答案有效，您可以单击其左上角的箭头“接受”。 :)
+1，好东西。但是你为什么要在函数中禁用屏幕更新？
你是对的，Reafidy。我把它拿出来了。我认为我把它包括在内只是出于习惯:)（不过，这是一个好习惯）
这样的答案就是 StackOverflow 存在的原因。非常感谢您为我节省了尝试自己动手的时间。

【解决方案2】：

只是@aevanko great function 的“通用”版本

Sub TestRegEx()
 Dim TextStr As String, PatternStr As String
 TextStr = "StartStr Ab12345678 EndStr"
 PatternStr = "(([a-z]{2})([0-9]{8}))"
 Debug.Print ExtractSubStrWRegEx(PatternStr, TextStr)
End Sub

Function ExtractSubStrWRegEx(ByVal PatternStr As String,ByVal TextStr As String) As String

 Dim RE As Object
 Set RE = CreateObject("vbscript.regexp")

 RE.Pattern = PatternStr
 RE.Global = True
 RE.IgnoreCase = True

 Dim allMatches As Object
 Set allMatches = RE.Execute(TextStr)

 If allMatches.Count <> 0 Then
  ExtractSubStrWRegEx = allMatches.Item(0).submatches.Item(0)
 Else
  ExtractSubStrWRegEx = ""
 End If

End Function

【讨论】：