Este fórum foi descontinuado. LEIA AQUI e participe da Comunidade BABOO :)

A área de Remoção de Malwares está aberta na Comunidade BABOO. LEIA AQUI

Ir para conteúdo
Vinicius Guarino

Macro - Várias buscas dentro de uma célula

Mensagem Recomendada

Pessoal, bom dia!

Gostaria de uma ajuda de vocês.

Gostaria de realizar uma busca dentro de uma célula, e que me retornasse todos os artigos nele..

EX que vem na célula:

""No que tange ao mérito, restou comprovada a infração ao disposto no art. 20 da Lei nº 9.656 de 1998 c/c art. 3º da Resolução RDC nº 29, de 26 de junho de 2000, pela não comunicação prévia de aplicação de reajuste por variação anual de custos de plano coletivo, com 30 (trinta) dias de antecedência. Em conseqüência, fixo, pela não comunicação de reajuste dentro do prazo legal, a pena pecuniária base em R$ 45.000,00 (quarenta e cinco mil reais), nos termos do artigo. 25, inciso II da Lei nº 9.656 de 1998 c/c art. 6º, inciso IV, da Resolução RDC nº 24, de 13 de junho de 2000, uma vez que não se reconhece a presença de circunstâncias agravantes ou atenuantes na conduta repreendida e considerando a incidência do fator multiplicador previsto no artigo 15, inciso III, da mesma Resolução, fixo a pena pecuniária final em R$ 27.000,00 (vinte e sete mil reais).""

Gostaria que todos esses artigos encontrado na célula A1, viessem nas células B1,C1,D1,F1.... assim sucessivamente de acordo com o numero de artigos encontrado na célula A1.

Teria alguma forma de realizar essa busca através de alguma macro ou algum tipo de formula? Obrigado desde já!

Compartilhar este post


Link para o post
Compartilhar em outros sites

Experimente:

Sub ExtraiArtigos()
 Dim wrdTexto() As String, i As Long, strg As String, k As Long
 Dim strTexto As String
  strTexto = Replace(Replace([A1], ",", " "), "º", "º ")
  wrdTexto() = Split(strTexto)
   For i = LBound(wrdTexto) To UBound(wrdTexto) - 1
    If 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

resultado em B1:F1 ~~~> |  art. 20  |  art. 3º |  artigo. 25 |  art. 6º  |  artigo 15  |


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Oi Osvaldo, obrigado!!!!

estou a dois dias tentando fazer isso, muito obrigado mesmo! porém, por falta de atenção, esqueci de mencionar 2 coisas: 

 como faço para que a macro funcione em uma quantidade de linha maior? pq a planilha tem em média 2.000 à 10.000 linhas, gostaria que rodasse em todas as linhas... 

 

a outra é que tem Ex."art.209" com o ponto junto como faço essa alteração?.

 

estou tentando fazer essas alterações porem depura!

obrigado!

Obrigado novamente!

Editado por Vinicius Guarino

Compartilhar este post


Link para o post
Compartilhar em outros sites

1° ...a planilha tem em média 2.000 à 10.000 linhas, gostaria que rodasse em todas as linhas...
Considerei que as células a serem processadas estão todas na coluna A.

2° a outra é que tem Ex."art. 209 " com o ponto junto como faço essa alteração?.
Ok, alterei o código.

 

Sub ExtraiArtigosV2()
 Dim wrdTexto() As String, i As Long, k As Long, c As Range
  Application.ScreenUpdating = False
  For Each c In Range("A1", Cells(Rows.Count, 1).End(3))
   wrdTexto() = Split(Replace(Replace(c.Value, ",", ""), "º", "º "))
    For i = LBound(wrdTexto) To UBound(wrdTexto) - 1
     If InStr(1, wrdTexto(i), "art") > 0 And IsNumeric(Left(wrdTexto(i + 1), 1)) Then
       Cells(c.Row, k + 2) = wrdTexto(i) & " " & wrdTexto(i + 1): k = k + 1
     ElseIf InStr(1, wrdTexto(i), "art") > 0 And IsNumeric(Right(wrdTexto(i), 1)) Then
      Cells(c.Row, k + 2) = wrdTexto(i): k = k + 1
     End If
    Next i
    k = 0
   Next c
  Application.ScreenUpdating = True
End Sub

 

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

×
×
  • Criar Novo...