☰

如何从 Excel 中的混合文本中仅提取具有特定模式的数字？

tag-icon • tag-icon microsoft-excel worksheet-function
如何从 Excel 中的混合文本中仅提取具有特定模式的数字？

我需要从 Excel 中的混合文本中提取特定模式的数字。注意事项：

  1. 要提取的数字始终具有以下模式99.99.999.999
  2. 它所包含的字符串长度不一，要提取的数字的位置也各不相同。
  3. 所需数字的开头或结尾均没有字符，因此可以提取这些数字

例子：

01.11.202.037.2011_20171017150732.pdf  
01.26.304.012.09.re_20170621163250.pdf  
01.36.402.010 MAI 2011.pdf  
2011.mai.01.02.203.001_20170802112610.pdf  
lease_20161104110041.pdf  
re.01.02.203.001.2012_20171019085424.pdf  
16.20.116.014.14re_20170621161637.pdf

结果应该是：

01.11.202.037  
01.26.304.012  
01.36.402.010  
01.02.203.001  
NA  
01.02.203.001  
16.20.116.014

答案1

以下是使用正则表达式的一些内容。它适用于您的所有示例，并且还检查第一个和最后一个段分别不超过两位或三位数字：

Option Explicit
Function ExtractNumPattern(S As String) As String
    Dim RE As Object, MC As Object
    Const sPat As String = "(?:^|\D)(\d{2}\.\d{2}\.\d{3}\.\d{3})(?:\D|$)"

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = False
    .Pattern = sPat
    .MultiLine = True
    If .Test(S) = True Then
        Set MC = .Execute(S)
        ExtractNumPattern = MC(0).submatches(0)
    Else
        ExtractNumPattern = "NA"
    End If
End With
End Function

在此处输入图片描述

除了开头和结尾之外，正则表达式模式应该相当清晰。

第一部分(?:^|\D)确保值前面是非数字或行首。

最后一部分(?:\D|$)确保值后面跟着一个非数字或行尾。

答案2

太夸张了，你为什么总是去 VBA，我只会这样做

=MID(A1,SEARCH("??.??.???.???",A1),13)

并向下拖动公式，哦，是的，并为没有它的值添加错误更正

=IFERROR(MID(A1,SEARCH("??.??.???.???",A1),13),"NA")

在此处输入图片描述

答案3

如果你想要一个非常简单易用的 VBA 函数，

Option Explicit

Sub TestIt()
  Dim c As Range
  For Each c In ActiveSheet.UsedRange
    Debug.Print c, ParsedAddr(c)
  Next c
End Sub

Function ParsedAddr(c As Range) As String
  Dim i As Long, iLen As Long

  iLen = Len(c)
  For i = 1 To iLen - 12
    If IsNumeric(Mid(c, i, 1)) Then                              '9
      If IsNumeric(Mid(c, i + 1, 1)) Then                        '99
        If Mid(c, i + 2, 1) = "." Then                           '99.
          If IsNumeric(Mid(c, i + 3, 1)) Then                    '99.9
            If IsNumeric(Mid(c, i + 4, 1)) Then                  '99.99
              If Mid(c, i + 5, 1) = "." Then                     '99.99.
                If IsNumeric(Mid(c, i + 6, 1)) Then              '99.99.9
                  If IsNumeric(Mid(c, i + 7, 1)) Then            '99.99.99
                    If IsNumeric(Mid(c, i + 8, 1)) Then          '99.99.999
                      If Mid(c, i + 9, 1) = "." Then             '99.99.999.
                        If IsNumeric(Mid(c, i + 10, 1)) Then     '99.99.999.9
                          If IsNumeric(Mid(c, i + 11, 1)) Then   '99.99.999.99
                            If IsNumeric(Mid(c, i + 12, 1)) Then '99.99.999.999
                              Exit For
                            End If
                          End If
                        End If
                      End If
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  Next i
  If i < iLen - 11 Then
    ParsedAddr = Mid(c, i, 13)
  Else
    ParsedAddr = "NA"
  End If
End Function

VBA 确实可以让您嵌套所有您想要的内容，就这样！您可以使用子程序大量压缩此代码 - 例如搜索格式为“99。”或“999。”的字符 - 但尽管它并不“紧凑”，但它很漂亮 :) 不过我将其保留为空白，因此它非常容易理解。

我将其编写为一个函数，以便它可以适应将解析的字符串输出到单元格中。

答案4

这个问题真的让我绞尽脑汁，所以我决定自己尝试一下。我认为罗恩·罗森菲尔德的反应相当直截了当并且可能更加优雅；因此一定要首先考虑该方法。

我使用以下方法：

  1. 将字符串变成一个简单的模式；周期相等0s 和所有其他字符相等1秒。
  2. 然后搜索 OP 要求的模式；##.##.###.### = 1101101110111
  3. 搜索返回模式的起始索引 - 从该索引返回 13 个数字。

与往常一样，附加代码用于捕获错误、提供小幅性能提升（使用 5k 重复记录进行测试）并帮助改善逻辑。

下面是 xlsm 布局的图像：

图片链接

请访问此代码审查帖子进行更深入的分析托马斯因齐纳以及来自急性肾衰竭，他帮助提高了下面代码的质量。

Sub PatternScrub()

Dim Pattern As String
Dim x As Integer
Dim data As Variant
Dim Target As Range

With ThisWorkbook.Worksheets("Sheet1")
    Set Target = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With

data = Target.Value

    PerformanceBoost True

        For x = 1 To UBound(data)
            If data(x, 1) Like "*##.##.###.###*" Then
                data(x, 1) = getPatternValue(CStr(data(x, 1)))
            Else
                data(x, 1) = "NA"
            End If
        Next

        Target.Offset(0, 1).Value = data

    PerformanceBoost False

End Sub

Private Function Pattering(ByVal Target As String) As String

Dim i As Integer

    For i = 1 To Len(Target)
       Mid(Target, i, 1) = IIf(Mid(Target, i, 1) = ".", 0, 1)       'TURNS THE STRING INTO 1s AND 0s
    Next

Pattering = Target

End Function

Private Function PatternIndex(ByVal Pattern As String) As Integer

    On Error Resume Next
    PatternIndex = Application.WorksheetFunction.Search("1101101110111", Pattern)       ' MATCHES THE PATTERN AND RETURNS THE FIRST INDEX

End Function

Private Function getPatternValue(Text As String) As String

    Dim x As Long
    x = PatternIndex(Pattering(Text))
    getPatternValue = Mid(Text, x, 13)

End Function

Sub PerformanceBoost(TurnOn As Boolean)

    With Application
        .Calculation = IIf(Turn, xlCalculationManual, xlCalculationAutomatic)
        .ScreenUpdating = Not TurnOn
        .DisplayStatusBar = Not TurnOn
        .EnableEvents = Not TurnOn
    End With

End Sub

相关内容