Excel VBA +正则表达式

Question

好的，开始吧。我在VBA上有点生疏，3年以来我需要使用它。

简而言之，我正努力从字符串中提取文本。我使用正则表达式从该字符串中提取我的部门名称和日期。

部门将始终介于：和 - 。

之间

由于安全性，我无法共享该文档。但是，我可以解释这种格式，希望我们可以从中解决这个问题。

Col A ---- Col B ---- Col C --- Col D

日期（E） - 部门（E） - 字符串 - 持续时间

其中（e）表示它是从字符串中提取的。

到目前为止，我的提取代码如下。目前它将循环遍历所有可用行并提取部门，但它始终采用：和 - 用它！我似乎无法找到削减这些的方法。

有任何帮助吗？

我最终可能会计算出日期位。

此代码的最终输出是“：入站联系人 - ” 我需要的地方，“入站联系人”。

Sub stringSearch()
    Dim ws As Worksheet
    Dim lastRow As Long, x As Long
    Dim matches As Variant, match As Variant
    Dim Reg_Exp As Object

    Set Reg_Exp = CreateObject("vbscript.regexp")

    Reg_Exp.Pattern = "\:\s(\w.+)\s\-"


    Set ws = Sheet2

    lastRow = ws.Range("C" & Rows.Count).End(xlUp).Row

    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("C" & x).Value))
        If matches.Count > 0 Then
            For Each match In matches
                ws.Range("B" & x).Value = match.Value
            Next match
        End If
    Next x
End Sub

Answer 1

这是如何在没有regex的情况下实现您想要的目标，一般来说它应该更快一些，更容易理解：

Sub TestMe()

    Dim inputString As String
    inputString = "Planning Unit: Inbound Contacts = Tuesday, 27/03/2018"
    Debug.Print Split(Split(inputString, ":")(1), "=")(0)

End Sub

• 将inputString拆分为:并取下第二部分;
• 将被采取的部分拆分为=并采取第一部分;

Answer 2

您没有访问第1组值。

而不是ws.Range("B" & x).Value = match.Value使用

ws.Range("B" & x).Value = match.Submatches(0)

您也可以将正则表达式增强到

Reg_Exp.Pattern = ":\s*(\w.*?)\s*-"

这样，你将＆＃34;修剪＆＃34;第1组价值。请参阅the regex demo。

<强>详情

• : - :字符
• \s* - 0+空白字符
• (\w.*?) - 第1组（.Submatches(0)）：字符char跟随任意0+字符（除了换行符之外）尽可能少（注意\w不匹配非ASCII字母，可能你想匹配任何不是空格而不是-的字符，然后使用[^\s-]代替\w）
• \s* - 0+空白字符
• - - 连字符。

Answer 3

的正则表达式：

您可以使用此正则表达式：([\s\S]+?):\s*([\s\S]+?)\s*-\s*([A-z]+)\s*,\s*([0-9]{2}\/[0-9]{2}\/[0-9]{4})\b

demo

代码：

这段代码：

Sub stringSearch()
    Dim ws As Worksheet
    Dim lastRow As Long, x As Long
    Dim matches As Variant, match As Variant
    Dim Reg_Exp As Object

    Set Reg_Exp = CreateObject("vbscript.regexp")

    Reg_Exp.Pattern = "([\s\S]+?):\s*([\s\S]+?)\s*-\s*([A-z]+)\s*,\s*([0-9]{2}\/[0-9]{2}\/[0-9]{4})\b"


    Set ws = Sheet2

    lastRow = ws.Range("C" & Rows.Count).End(xlUp).Row

    For x = 1 To lastRow
        Set matches = Reg_Exp.Execute(CStr(ws.Range("C" & x).Value))
        If matches.Count > 0 Then
            For Each match In matches
                For i = 0 To match.SubMatches.Count - 1
                    Debug.Print match.SubMatches(i)
                Next i
            Next match
        End If
    Next x
End Sub

结果

这是即时窗口的结果：

+-------------------+
| Planning Unit     |
| Inbound Contracts |
| Tuesday           |
| 27/03/2018        |
| Planning Unit     |
| Payments & Orders |
| Tuesday           |
| 27/03/2018        |
| Planning Unit     |
| Scheduling        |
| Tuesday           |
| 27/03/2018        |
+-------------------+

Answer 4

在这种情况下，我会使用Left / Right / Mid和InStr / InStrRev而不是RegEx。

提取部门：

Dim mainStr As String
Dim deptStr As String
mainStr = "Planning Unit: Inbound Contacts - Tuesday, 27/03/2018"
deptStr = Mid(mainStr, InStr(mainStr, ":") + 2)
deptStr = Left(deptStr, InStr(deptStr, "-") - 2)

用于提取日期：

Dim mainStr As String
Dim dateStr As String
mainStr = "Planning Unit: Inbound Contacts - Tuesday, 27/03/2018"
dateStr = Right(mainStr, Len(mainStr) - InStrRev(mainStr, " "))

说实话，这种情况很常见，你可能想写一些“extractText”函数来获取分隔符之间的文本。这是我使用的那个。

Function extractText(str As String, leftDelim As String, rightDelim As String, _
                     Optional reverseSearch As Boolean = False) As String
'Extracts text between two delimiters in a string
'By default, searches for first instance of each delimiter in string from left to right
'To search from right to left, set reverseSearch = True
'If left delimiter = "", function returns text up to right delimiter
'If right delimiter = "", function returns text after left delimiter
'If left or right delimiter not found in string, function returns empty string

    Dim leftPos As Long
    Dim rightPos As Long
    Dim leftLen As Long
    If reverseSearch Then
        leftPos = InStrRev(str, leftDelim)
        rightPos = InStrRev(str, rightDelim)
    Else
        leftPos = InStr(str, leftDelim)
        rightPos = InStr(str, rightDelim)
    End If

    leftPos = IIf(leftDelim = "", -1, leftPos)
    rightPos = IIf(rightDelim = "", -1, rightPos)
    leftLen = Len(leftDelim)

    If leftPos > 0 Then
        If rightPos = -1 Then
            extractText = Mid(str, leftPos + leftLen)
        ElseIf rightPos > leftPos Then
            extractText = Mid(str, leftPos + leftLen, rightPos - leftPos - leftLen)
        End If
    ElseIf leftPos = -1 Then
        If rightPos > 0 Then
            extractText = Left(str, rightPos - 1)
        End If
    End If

End Function