用 VBA 删除文本（左或右），所以我只保留一个特定的字符串

Question

每天我们都会收到一个包含数据库转储的 Excel 文件。大多数文件都在我制作的 VBA 脚本中进行排序，但我还有一个无法解决的问题。在其中一列 (A) 中，我有时有 2 个字符串，我只喜欢保留其中一个。我想保留的字符串看起来像“M1234 5678”。数字确实变了... 该列有时在 M1234 5678 之前或之后有其他文本。我想删除所有这些文本，所以我只保留所需的字符串。

我已经尝试使用搜索功能尝试使用修剪功能并搜索看起来像“M#### ####”的字符串来解决问题。走这条路没有运气。我不得不承认，在 2 周前，我一直在使用下面的代码，可能会因为我当时试图解决的问题而搞砸了。

    Sub TrimText()
       Dim FinalValue As String
       Dim lastStop As Long
       With Sheets("Blad2")
       lastStop = .Cells(.Rows.Count, "A").End(xlUp).Row
       For i = 2 To lastStop
       FinalValue = Trim(Cells(i, 1).Value)
       If InStr(FinalValue, "ALQ") > 0 Then
       Cells(i, 1).Value = Left(FinalValue, InStr(FinalValue, "M*"))
       End If
       Next
       End With
    End Sub

我希望删除 M#### #### 字符串左侧或右侧的任何文本。

感谢您的帮助。

Answer 1

我得到它的工作方式如下；

    Option Explicit
    Public Sub TrimText()
        Dim FinalValue As String, lastStop As Long, i As Long, re As Object
        Set re = CreateObject("VBScript.RegExp")
            lastStop = Cells(Rows.Count, "A").End(xlUp).Row
            For i = 2 To lastStop
                FinalValue = Trim(Cells(i, 1).Value)
                Cells(i, 1).Value = ReplaceMatch(re, Cells(i, 1).Value, "M\d{4}\s\d{4}")
            Next
    End Sub

    Public Function ReplaceMatch(ByVal re As Object, inputString As String, ByVal pattern As String) As String
        With re
            .Global = True
            .MultiLine = True
            .pattern = pattern

            If .test(inputString) Then
                ReplaceMatch = .Execute(inputString)(0)
            Else
                ReplaceMatch = inputString
            End If
        End With
    End Function

非常感谢您的帮助。

Answer 2

如果字符串长度保持不变，您可以使用正则表达式模式

M\d{4}\s\d{4}

这可能看起来像一个函数调用（如果条件已删除）

Option Explicit
Public Sub TrimText()
    Dim FinalValue As String, lastStop As Long, i As Long, re As Object
    Set re = CreateObject("VBScript.RegExp")
    With ThisWorkbook.Worksheets("Blad2")
        lastStop = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastStop
            FinalValue = Trim(Cells(i, 1).Value)
            .Cells(i, 1).Value = ReplaceMatch(re, .Cells(i, 1).Value, "M\d{4}\s\d{4}")
        Next
    End With
End Sub

Public Function ReplaceMatch(ByVal re As Object, inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .MultiLine = True
        .pattern = pattern

        If .test(inputString) Then
            ReplaceMatch = .Execute(inputString)(0)
        Else
            ReplaceMatch = inputString
        End If
    End With
End Function