Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Pesquisar por palav...
 
Notifications
Clear all

Pesquisar por palavras Chaves

 
2024 - VBA & Macros
Post Recente por thiago.x 10 anos atrás
3 Posts
2 Usuários
0 Reactions
971 Visualizações
RSS
 thiago.x
(@thiago-x)
Posts: 0
New Member
Topic starter
 

Como fazer com que o resultado do protótipo abaixo apareça preenchendo as células?

fiz um protótipo, se quiser usar, jogue dentro de um módulo: 

'byJackSSL 
'recebe item a pesquisar,coluna a efetuar a pesquisa e 
'tipo de pesquisa. 
'retorna todas as ocorrências do item pesquisado 
'se passar 1 como tipo pesquisa, retorna somente palavra exata, 0 retorna palavra semelhante 
Public Function PesquisaItem( _ 
ByVal strpesquisa As String, _ 
ByVal coluna_pesquisa As Range, _ 
ByVal tipo_pesquisa As Integer) As String 
On Error Resume Next 
Dim str_result As String 
Dim i As Integer 
Dim tem_resultado As Boolean 
Dim ultima_linha As Integer 
Dim linha_leitura As String 
'pegamos a última linha preenchida da coluna 
ultima_linha = CInt( Range( coluna_pesquisa.Address ).End( xlDown ).Cells.Row ) + 1 
str_result = Empty 
tem_resultado = False 
If strpesquisa <> Empty Then 'se pesquisa foi preenchida 
'pecorremos 1 a 1 as células da coluna selecionada em busca de ocorrências 
For i = 0 To ultima_linha - 1 Step 1 
linha_leitura = Plan1.Cells( i , Range( coluna_pesquisa.Address ).End( xlDown ).Cells.Column ) 
'se tipo da pesquisa = 1 (pesquisa exata) 
If tipo_pesquisa = 1 Then 
If linha_leitura = strpesquisa Then 
tem_resultado = True 
str_result = "- " & linha_leitura & "*#*" & str_result 
End If 
Else 'pesquisa ocorrencia contendo a palavra chave 
If InStr(1, linha_leitura, strpesquisa) Then 
tem_resultado = True 
str_result = "- " & linha_leitura & vbCrLf & str_result 
End If 
End If 
Next i 
'exibe caixa de mensagem com as ocorrências 
If Not tem_resultado Then 
MsgBox "nenhuma ocorrência da palavra pesquisada foi encontrada!" 
Else 
MsgBox str_result 
End If 
PesquisaItem = "1" 
Else 
PesquisaItem = "0" 
End If 
End Function

um exemplo de uso: suponha que queira pesquisar na coluna A, a partir de A1 até a última linha preenchida desta coluna, e queira pesquisar por "produto blabla". vamos dizer que vai usar a célula D1 para digitar a sua pesquisa e a célula D2 para jogar a fórmula.
ponha em D2:
=PesquisaItem(D1; A1; 1)

onde D1 é a célula onde vai digitar a pesquisa, A1 a coluna onde vai ser feita a busca e "1" significa que quer buscar ocorrências exatas da palavra pesquisada.

se quiser procurar por qualquer produto que tenha a palavra "blabla" na descrição, poderia ser:
=PesquisaItem(D1; A1; 0)

o argumento "0" faz uma pesquisa pela ocorrência da palavra chave, mesmo que associada a outras palavras na descrição.

o resultado é exibido em uma caixa de mensagem, mas gostaria de adaptar para jogar em células o resultado.

Alguém pode me ajudar?

 
Postado : 28/11/2014 6:05 am
 Reinaldo
(@rlm)
Posts: 0
New Member
 

Como trata-se de uma pesquisa que pode retornar de Zero a N resultados, então deve ser tratada como Array.
Então a maneira de utilizar a função altera-se um pouco.
Insira a formula em E1=PesquisaItem(D1;C1;0), então seleciona a range E1:E30 (por exemplo), tecla F2, então tecle Ctrl+Alt+Enter pois trata-se de uma matricial
A função ficara =/- assim

'byJackSSL
'recebe item a pesquisar,coluna a efetuar a pesquisa e tipo de pesquisa.
'retorna todas as ocorrências do item pesquisado
'se passar 1 como tipo pesquisa, retorna somente palavra exata, 0 retorna palavra semelhante
Public Function PesquisaItem(ByVal strpesquisa As String, _
                             ByVal coluna_pesquisa As Range, _
                             ByVal tipo_pesquisa As Integer) As Variant
On Error Resume Next

Dim linha_leitura As String
Dim i As Integer, ultima_linha As Integer, x As Integer
Dim vEncontrado() As String
Dim tem_resultado As Boolean
Dim cIni As Long, lIni As Long
Dim Resultou, RowNdx, ColNdx

cIni = ActiveCell.Column: lIni = ActiveCell.Row
'pegamos a última linha preenchida da coluna
ultima_linha = CInt(Range(coluna_pesquisa.Address).End(xlDown).Cells.Row) + 1
tem_resultado = False

'se pesquisa foi preenchida pecorremos 1 a 1 as células da coluna selecionada em busca de ocorrências
If strpesquisa <> Empty Then
    For i = 0 To ultima_linha - 1 Step 1
        linha_leitura = Plan1.Cells(i, Range(coluna_pesquisa.Address).End(xlDown).Cells.Column)
        'se tipo da pesquisa = 1 (pesquisa exata)
        If tipo_pesquisa = 1 Then
            If linha_leitura = strpesquisa Then
                ReDim Preserve vEncontrado(0 To x)
                tem_resultado = True
                vEncontrado(x) = linha_leitura
                x = x + 1
            End If
        Else
            'pesquisa ocorrencia contendo a palavra chave
            If InStr(1, linha_leitura, strpesquisa) Then
                ReDim Preserve vEncontrado(0 To x)
                tem_resultado = True
                vEncontrado(x) = linha_leitura
                x = x + 1
            End If
        End If
    Next i
    If Not tem_resultado Then
        ReDim vEncontrado(1)
        vEncontrado(0) = "nenhuma ocorrência da palavra pesquisada foi encontrada!"
    Else
    End If
Else
End If
ReDim Resultou(1 To UBound(vEncontrado) + 1, 1 To 1)
    
For RowNdx = 1 To UBound(vEncontrado) + 1
    For ColNdx = 1 To 1
    Resultou(RowNdx, ColNdx) = vEncontrado(RowNdx - 1)
    Next ColNdx
Next RowNdx
PesquisaItem = Resultou
End Function
 
Postado : 28/11/2014 1:15 pm
 thiago.x
(@thiago-x)
Posts: 0
New Member
Topic starter
 

Muito obrigado!!

Meu problema foi solucionado, passei dias tentando descobrir e não consegui.

Meus parabéns!!

Abraço.

 
Postado : 01/12/2014 8:36 am
Forum Jump:
  Tópico Anterior
Próximo Tópico