Vba 从excel中提取特定格式

实际上，我在Java方面没有任何经验，并且依赖于古老的Java知识

我有以下格式的数据，我想提取001-222-170组件（从第1行等）

经过广泛的研究，我知道你必须建立一个

.pattern

识别系统。最接近我的是

Sub RegEx()
    Dim RegEx As Object
    Dim strTest As String
    Dim valid As Boolean
    Dim Matches As Object
    Dim i As Integer

    Set RegEx = CreateObject("VBScript.RegExp")
    'What I happen to be looking for    
    RegEx.Pattern = "MT\d{6}V\d"

    For i = 2 To 115
        Range("B" & i).Activate
        strTest = ActiveCell.Text
        valid = RegEx.test(strTest)
        If valid = True Then
            Set Matches = RegEx.Execute(strTest)
            Range("C" & i).Value = CStr(Matches(0))
        Else
            Range("C" & i).Value = "#N/A#"
        End If
    Next

    Set RegEx = Nothing
End Sub

---

但它仍然不起作用，而且我知道还有一个更短的方法可以做到这一点。我只是不知道如何格式化图案线。类似于

（“（\d）”-“（\d）”-“（\d）”）

？

如果数据始终是您需要的XXX-XXX-XXX格式，您可以在不使用VBA或RegEx的情况下在电子表格上进行写入

更新VBA解决方案

这里还有一个更简单的VBA解决方案，没有RegExp

注意：此解决方案假定单元格文本模式中除XXX-XX-XXX模式外，不会有任何其他“-”实例

Sub dude()

Dim strTest As String

For i = 2 To 115

    strTest = Range("A" & i).Text

    If InStr(1, strText, "-") > 0 Then
        Range("C" & i) = Mid(strTest, InStr(1, strText, "-") - 3, 11)
    Else
        Range("C" & i) = "#N/A#"
    End If

Next

End Sub

---

可以使用的模式是：

\d+-\d+-\d+

<代码>\d+仅表示一个或多个十进制数。 该分包可以写为：

Sub RegEx()
    Dim RegEx As Object
    Dim strTest As String
    Dim valid As Boolean
    Dim Matches As Object
    Dim i As Integer

    Set RegEx = CreateObject("VBScript.RegExp")

    RegEx.Pattern = "\d+-\d+-\d+"

    For i = 2 To 115
        strTest = Range("B" & i).Text
        Set Matches = RegEx.Execute(strTest)
        If Matches.Count > 0 Then
            Cells(i, "C").Value = CStr(Matches(0))
        Else
            Cells(i, "C").Value = "#N/A#"
        End If
    Next

    Set RegEx = Nothing
End Sub

---

如果你的格式是一样的，你想要一个VBA的解决方案，那么正则表达式对于这类事情来说是一个过度的杀伤力。下面是使用

SPLIT（）的简单方法

下面的代码将RegExp UDF转储到C2:C115，并在一次快照（无循环）中分别在B2:b115上运行

您的regexp可以缩短为
（\d{3}-）{2}\d{3}”

为了防止第一个“-”不是电话号码的一部分，您可以稍微修改该公式以搜索“-？-”其中？是任何字符，即
=MID（A1，搜索（“-？”，A1）-3,11）
谢谢您，先生，您让我高兴了。太好了！如果这个答案令人满意，请将其标记为已接受，以便其他人将来可以更容易地从中受益。但是，现在当我拖动单元格时，复制excell单元格不会增加，这与批量复制的目的不符。我需要调整一些设置吗？这太笼统了。Using
LIKE
现在会更好，因为我不知道sub是什么，所以如何将其声明为函数？顺便说一下，您可以添加对
Microsoft VBScript正则表达式5.5
的引用，并且您可以获得该Regex对象的一些智能感知支持。sub（子例程）就像一个void函数，您已经在示例中使用了它。但是，如果您的意思是需要另一种返回特定值的格式，那么所需的设置是什么？我希望将它用作excell中的函数，以便可以过滤文件。我可以将其用作函数吗？该模式太笼统了。它需要任意长度的数字，而不是而不是指定3。@user1475109请参阅我的文章，该文章结合了一个UDF和一个范围转储，这就是我在文章中提到的
如果您的格式与当前所有示例的格式相同：）如果格式不同，则上述解决方案不适用：）
Sub RegEx()
    Dim RegEx As Object
    Dim strTest As String
    Dim valid As Boolean
    Dim Matches As Object
    Dim i As Integer

    Set RegEx = CreateObject("VBScript.RegExp")

    RegEx.Pattern = "\d+-\d+-\d+"

    For i = 2 To 115
        strTest = Range("B" & i).Text
        Set Matches = RegEx.Execute(strTest)
        If Matches.Count > 0 Then
            Cells(i, "C").Value = CStr(Matches(0))
        Else
            Cells(i, "C").Value = "#N/A#"
        End If
    Next

    Set RegEx = Nothing
End Sub

RegEx.Pattern = "\d{3}\-\d{3}\-\d{3}"

Sub Sample()
    Dim MyAr() As String, strSample As String

    strSample = "TEXT,TEXT,TEXT,001-222-170,TEXT"
    'strSample = "LINER,612-942-001,TEXT"

    MyAr = Split(strSample, ",")

    Debug.Print MyAr(UBound(MyAr) - 1)
End Sub

Sub DumpReg()
    Range("C2:115").FormulaR1C1 = "=EXTRACT1(RC[-1])"
End Sub

Function Extract1(strIn As String) As String
    Dim objRegex As Object
    Dim objRegMC As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Pattern = "(\d{3}\-){2}\d{3}"
        If .test(strIn) Then
            Set objRegMC = .Execute(strIn)
            Extract1 = objRegMC(0)
        Else
            Extract1 = "#N/A#"
        End If
    End With
End Function