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

  • Pergunta

  • 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


    terça-feira, 29 de novembro de 2016 16:59

Respostas

  • 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

    quarta-feira, 30 de novembro de 2016 13:04
    Moderador

Todas as Respostas

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



    http://www.ambienteoffice.com.br

    quarta-feira, 30 de novembro de 2016 11:08
    Moderador
  • Segue... https://www.sendspace.com/file/8ycawc
    quarta-feira, 30 de novembro de 2016 11:38
  • 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

    quarta-feira, 30 de novembro de 2016 13:04
    Moderador
  • Bom dia a todos!

    Felipe, funcionou perfeitamente, muito obrigado pela ajuda!

    Att.

    Vinicius

    sexta-feira, 2 de dezembro de 2016 11:40
  • 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

    terça-feira, 27 de dezembro de 2016 11:33
    Moderador
  • 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




    terça-feira, 27 de dezembro de 2016 19:38
  • 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

    terça-feira, 27 de dezembro de 2016 22:47
    Moderador