Как извлечь только те числа, которые находятся в определенном шаблоне из смешанного текста в Excel?

Question

Мне нужно извлечь определенный образец чисел из смешанного текста в 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 

Answer 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|$) гарантирует, что за значением следует либо не цифра, либо конец строки.

Answer 2

Такое излишество, почему вы всегда ходите на VBA, я бы просто сделал

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

И перетащите вниз формулу, о да, и включите исправление ошибок для значений без него

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

Answer 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" - но, хотя это не "плотно", это красиво :) Я оставляю это голым, хотя так просто следовать.

Я написал это как функцию, чтобы ее можно было адаптировать для вывода проанализированных строк в ячейки.

Answer 4

Этот вопрос действительно задевал мой мозг, поэтому я решил сделать это сам. Я думаю, что ответ Рона Розенфельда довольно прост и, возможно, немного более ласков; поэтому обязательно рассмотрим этот метод в первую очередь.

Я использую следующую методологию:

1. Превратите строку в простой шаблон; периоды равны 0 с, а все остальные символы равны 1 с.
2. Затем найдите шаблон, который запрашивает OP; ##.##.###.### = 1101101110111
3. Поиск возвращает начальный индекс шаблона - из этого индекса возвращает 13 чисел.

Дополнительный код, как обычно, предназначен для перехвата ошибок, обеспечивает небольшое повышение производительности (протестировано с 5k дублированных записей) и помогает улучшить логику.

Ниже приведено изображение макета xlsm:

ССЫЛКА ИЗОБРАЖЕНИЯ

Пожалуйста, посетите этот пост обзора кода для более глубокого анализа Томаса Инзина и указателей из AJD, которые помогли улучшить качество кода ниже.

---

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