none
Loop na planilha RRS feed

  • Pergunta

  • Pessoal, bom dia!

    tenho essa macro de busca que um amigo me ajudou:

    ela busca todas as palavra em ART. 152 , artigo 114art. 221 e ARTIGO 38

    1° Porem, quando a palavra é ART.152artigo.114art.221 e ARTIGO.38 com o ponto junto da palavra ela não puxa.

    2° Gostaria q a macro fizesse um loop na coluna A até a ultima linha da planiha, pq ela tem em média 20.000 linhas e que a resposta viesse normalmente como vem nas colunas no lado, resumindo: ela está fixa somente em uma célula e não está percorrendo...

    alguém poderia me ajudar adaptar ela? 

    Sub ExtraiArtigos()
    Dim wrdTexto() As String, i As Long, strg As String, k As Long
    Dim strTexto As String
    strTexto = Replace(Replace([A2], ",", " "), "º", "º ")
    wrdTexto() = Split(strTexto)
    For i = LBound(wrdTexto) To UBound(wrdTexto) - 1
    If InStr(1, wrdTexto(i), "art") > 0 Or InStr(1, wrdTexto(i), "ART") > 0 And _
    IsNumeric(Left(wrdTexto(i + 1), 1)) Then
    Cells(1, k + 2) = wrdTexto(i) & " " & wrdTexto(i + 1): k = k + 1
    End If
    Next i
    End Sub

    Obrigado

    segue planilha em anexo
    segunda-feira, 27 de agosto de 2018 15:38

Todas as Respostas

  • consegui!!! Sub ExtraiArtigos() Dim wrdTexto() As String, strTexto As String Dim i As Long, k As Long, lRow As Long, x As Long 'Determina o numero delinhas preenchidas na coluna A lRow = Cells(Cells.Rows.Count, "E").End(xlUp).Row k = 0 'inicia loop para leitura da coluna A For x = 2 To lRow strTexto = Replace(Replace(Cells(x, "E"), ",", " "), "º", "º ") strTexto = Replace(Replace(Cells(x, "E"), ".", ". "), " ", " ") wrdTexto() = Split(strTexto) For i = LBound(wrdTexto) To UBound(wrdTexto) - 1 If InStr(1, UCase(wrdTexto(i)), "ART.") > 0 Or InStr(1, UCase(wrdTexto(i)), "ART") > 0 And _ IsNumeric(Left(wrdTexto(i + 1), 1)) Then Cells(x, k + 6) = wrdTexto(i) & " " & wrdTexto(i + 1): k = k + 1 End If Next i k = 0 Next x MsgBox "Artigos Extraídos com sucesso!" End Sub
    segunda-feira, 27 de agosto de 2018 18:10