VBA中的RegEx：如果在一定长度的数字后出现文本/特殊字符，则删除多余的数字

Question

目前，我的代码删除了单元格值中的所有文本和特殊字符，只留下了数字。

剩下要做的唯一事情是在一定长度后出现文本/特殊字符后删除数字

例。

412074442（和）2367

我的代码只输出0412 074 4422367，但应该是0412 074 442删除“（y）”之后的多余数字

Dim strPattern As String: strPattern = "^4(\d\d)(\d\d\d)(\d\d\d)"
Dim strReplace As String: strReplace = "04$1 $2 $3"
Dim strPattern2 As String: strPattern2 = "[^0-9]"
Dim strReplace2 As String: strReplace2 = ""

Set Myrange = ActiveSheet.Range("A2:A8") '***change range to determined text

    For Each cell In Myrange
        If strPattern2 <> "" Then
            strInput = cell.Value

            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = strPattern2
            End With

            If regEx.test(strInput) Then
            'MsgBox (regEx.Replace(strInput, strReplace))
                cell.Value = regEx.Replace(strInput, strReplace2)

            Else
            'MsgBox ("Not matched")
            End If
        End If
    Next

        For Each cell In Myrange
            If strPattern <> "" Then
                strInput = cell.Value

                With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = strPattern
                End With

            If regEx.test(strInput) Then
            'MsgBox (regEx.Replace(strInput, strReplace))
                cell.Value = regEx.Replace(strInput, strReplace)

            Else
            'MsgBox ("Not matched")
            End If
            End If
        Next

    For Each cell In Myrange
                strInput = cell.Value

        If Len([strInput]) <> 12 Then
        'MsgBox "Error"
            cell.Interior.ColorIndex = 3
        Else
        End If

        If Len([strInput]) = 0 Then
        'MsgBox "Error"
            cell.Interior.ColorIndex = 0
        Else

        End If
    Next
End With

需要帮助，谢谢。

Answer 1

您可以稍微改变解决方案的体系结构。因此，以下内容：

• 首先寻找(y)并在其右侧切割任何东西。
• 然后使用RegEx删除非数字字符。

这是从（y）右侧删除部件的代码：

Option Explicit

Public Sub TestMe()

    Dim location As Long
    location = InStr(1, Range("A1"), "(y") - 1

    If location > 0 Then
        Range("a1") = Left(Range("a1"), location)
    End If

End Sub

Left Function MSDN