Como extrair apenas os números que estão em um padrão específico de texto misto no Excel?

Question

Eu preciso extrair um padrão específico de números de texto misto no Excel. Considerações:

1. O número a ser extraído sempre tem o padrão 99.99.999.999
2. A string em que ela está contida é de tamanho variado e a posição dos números a serem extraídos também varia.
3. Não há caracteres no começo ou no final dos números necessários, com base nos quais eles podem ser extraídos

Exemplos:

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  

O resultado deve ser:

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

Aqui está algo usando expressões regulares. Ele funciona em todos os seus exemplos e também verifica se o primeiro e o último segmentos têm no máximo dois ou três dígitos, respectivamente:

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

O padrão regex deve ser razoavelmente claro, exceto, talvez, para o começo e o fim.

A primeira parte (?:^|\D) garante que o valor seja precedido por um não dígito ou pelo início da linha.

A última parte (?:\D|$) garante que o valor seja seguido por um não dígito ou pelo fim da linha.

    

Answer 2

Tal exagero, por que você sempre vai ao VBA, eu apenas faria

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

E arraste para baixo a fórmula, oh sim, e inclua uma correção de erro para valores sem

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

    

Answer 3

Se você quiser um bastante simples para seguir a função 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

O VBA realmente permitirá que você aninhe tudo o que quiser, então lá! Você pode condensar esse código maciçamente usando sub-rotinas - por exemplo, procurando por caracteres do formato "99." ou "999" - mas, embora não seja "apertado", é bonito :) Estou deixando isso nua, por isso é extremamente simples de seguir.

Eu escrevi isso como uma função para que possa ser adaptado para gerar strings analisadas nas células.

    

Answer 4

Esta questão foi realmente pegando meu cérebro, então eu decidi dar o meu próprio tiro. Eu acho que a resposta de Ron Rosenfeld é muito simples e talvez um pouco mais elagante; então definitivamente considere esse método primeiro.

Estou usando a seguinte metodologia :

1. Transforme a string em um padrão simples; períodos iguais 0 s e todos os outros caracteres são iguais a 1 s.
2. Em seguida, procure o padrão que o OP pede; ##. ##. ###. ### = 1101101110111
3. A pesquisa retorna o índice inicial do padrão - desse índice, retorne 13 números.

O código adicional, como de costume, está lá para detectar erros, fornecer um pequeno aumento de desempenho (testado com registros duplicados de 5k) e ajudar a melhorar a lógica.

Abaixo, está uma imagem do layout do xlsm:

LINK DE IMAGEM

Visite esta postagem de revisão de código para uma análise mais aprofundada por Thomas Inzina e os ponteiros de AJD , que ajudou a melhorar a qualidade do código abaixo.

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