Formula ou Macro para Extrair registro de Data e de Valor em uma sequencia de texto

Question

Boa tarde pessoal!

Tenho um relatorio em pdf que infelizmente não consigo gerar em excel, então sempre tenho um retrabalho em copiar o pdf e colar no excel, e na sequência fazer alguns desmembramentos de informações.

Porém estou com dificuldade em acertar alguns detalhes, e gostaria de ver se vocês não poderiam me ajudar.

O arquivo de exemplo está para download no link https://www.4shared.com/file/-3s4974jba/exemplo.html

O objetivo é extrair das linhas as informações em vermelho, onde abaixo vou explicar o que são e qual problema estou tendo:

     1. Numero do Titulo: trata-se da primeira sequencia numerica de 7 digitos, onde através de uma Function consegui resolver

     2. Data do Pagamento: no arquivo vem uma data que preciso, e fiz uma formula procurando a barra, através da posição da barra eu volto 2 posições e extraio 10, porém neste caso meu problema ocorre quando existe barra no nome do cliente, como o exemplo da linha 2.

     3. Valores: para cada linha vem 4 blocos de valores, sendo valor pago, desconto, juros, valor final, assim como no caso da data eu faço via fórmula localizando a virgula, e depois extraindo o texto, porém meu problema ocorre quando o valor do titulo possui mais de 3 casas, ou seja, passa de mil reais.

Alguem teria alguma sugestão para resolvermos os pontos 2 e 3 que mencionei acima? (referente data e valores)...

Desde já agradeço e fico no aguardo.

Att.

Vinicius

Answer 1

Vinícius, teria como você postar o arquivo num serviço diferente do 4Shared como o SendSpace ou OneDrive?

---

http://www.ambienteoffice.com.br

Answer 2

Segue... https://www.sendspace.com/file/8ycawc

Answer 3

Sub Main()
    Dim RegExp As Object
    Dim iText As String
    Dim ws As Worksheet
    Dim iValues As Variant
    Dim iRow As Long
    Dim iSubMatch As Variant
    Dim iMatch As Object
    
    Set ws = ThisWorkbook.Worksheets("Plan1")
    
    Set RegExp = CreateObject("VBScript.RegExp")
    With RegExp
      .MultiLine = False
      .Global = False
      .IgnoreCase = True
      .Pattern = "(\d{7}).+(\d{2}\/\d{2}\/\d{4}).+?[\dP]+ ([\d, ]+) [^\d]"
    End With

    For iRow = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        iText = ws.Cells(iRow, "A")
        Set iMatch = RegExp.Execute(iText)
        ws.Cells(iRow, "G") = iMatch(0).SubMatches(0)
        ws.Cells(iRow, "H") = iMatch(0).SubMatches(1)
        iValues = Split(iMatch(0).SubMatches(2))
        ws.Cells(iRow, "I") = CDbl(iValues(0))
        ws.Cells(iRow, "J") = CDbl(iValues(1))
        ws.Cells(iRow, "K") = CDbl(iValues(2))
        ws.Cells(iRow, "L") = CDbl(iValues(3))
    Next iRow
End Sub

---

http://www.ambienteoffice.com.br

Answer 4

Bom dia a todos!

Felipe, funcionou perfeitamente, muito obrigado pela ajuda!

Att.

Vinicius

Answer 5

Option Explicit

Sub Main()
    Dim RegExp As Object
    Dim iText As String
    Dim ws As Worksheet
    Dim iValues As Variant
    Dim iRow As Long
    Dim iSubMatch As Variant
    Dim iMatch As Object
    
    Set ws = ThisWorkbook.Worksheets("Plan1")
    
    Set RegExp = CreateObject("VBScript.RegExp")
    With RegExp
      .MultiLine = False
      .Global = False
      .IgnoreCase = True
      .Pattern = "(\d{7}).+(\d{2}\/\d{2}\/\d{4}).+?[\dP]+ ([\d, ]+) [^\d]"
    End With

    For iRow = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        iText = ws.Cells(iRow, "A")
        Set iMatch = RegExp.Execute(iText)
        ws.Cells(iRow, "G") = iMatch(0).SubMatches(0)
        ws.Cells(iRow, "H") = iMatch(0).SubMatches(1)
        iValues = Split(iMatch(0).SubMatches(2))
        ws.Cells(iRow, "I") = CDbl(iValues(3))
    Next iRow
End Sub

---

http://www.ambienteoffice.com.br || Grupo de WhatsApp: https://chat.whatsapp.com/K1uey5Q4yJdKnsgWkVQAZG

Answer 6

Felipe, apliquei esta ultima macro à planilha anterior e funcionou, mas acho que eu não me expressei corretamente sobre a mudança que houve.

O texto gerado pelo relatório agora está com mais informações, onde possui 2 datas (não apenas 1), fora outros detalhes.
Tentei adaptar aquele código inicial para trazer a sequencia fixa de 7 digitos, mais as 2 datas, mais os 4 valores, porém não obtive sucesso.

Como o mais importante pra mim é o ultimo valor, abri aquele novo post questionando como ficaria.

Eu achei que trazendo o ultimo valor já resolveria meu problema, mas na verdade agora também notei que existe um problema na data, pois a data importante pra mim é a primeira e a macro traz a segunda.

Resumindo toda a história, vou colocar abaixo o novo padrão do texto, e se você puder me ajudar a adaptar a macro para trazer a sequencia fixa de 7, as 2 datas e os 4 valores, ficarei grato.

Obs.: Esta macro estava invertendo Ano e Mês conforme padrão americano (mm/dd/aaaa), como faço para resolver este problema também?

6017528 14 1091356 MARIA ISABEL BARBOS 3 19/12/2016 10/05/2016 42,90 42,90 3,60 46,50 LIQUIDAÇAO

6291879 14 1059603 MARLY COSTA MARTINS 3 19/12/2016 15/10/2016 40,53 40,53 0,00 40,53 LIQUIDAÇAO

6139623 14 1070211 DONIZETE VASCO GARC 3 19/12/2016 28/10/2016 58,01 58,01 3,90 61,91 LIQUIDAÇAO

6193297 14 1070211 DONIZETE VASCO GARC 3 19/12/2016 28/10/2016 58,01 58,01 3,90 61,91 LIQUIDAÇAO

6696318 14 835136 OVIDIO FALAVIGNA NE 3 19/12/2016 10/11/2016 45,82 45,82 4,08 49,90 LIQUIDAÇAO

6328619 14 824348 TSUEO EMORI 3 19/12/2016 15/11/2016 27,17 27,17 1,90 29,07 LIQUIDAÇAO NORMAL A

Answer 7

Postei inadvertidamente neste tópico. Era para postar no outro.

Respondi no outro: https://social.msdn.microsoft.com/Forums/pt-BR/c10650fe-7ba1-4210-941a-27abffe2cac2/macro-para-extrair-registro-de-data-e-de-valor-em-uma-sequencia-de-texto?forum=vbapt

Vou trancar este tópico.

---

http://www.ambienteoffice.com.br || Grupo de WhatsApp: https://chat.whatsapp.com/K1uey5Q4yJdKnsgWkVQAZG