Pesquisa em lista de contactos - Excel

[rsmartins]

Boas!

Estou a fazer uma lista de contactos em excel (VBA) com uma série de campos que devem ser preenchidos, passo a explicar:

Quando inicio o excel surge um form de login, após o login bem sucedido surge uma folha de calculo onde está inserido um botão, carregando nesse botao surge um form com 11 campos, sendo eles: Nome, Morada, Localidade, Cod postal, Telf., Telem., Fax, Mail, Web, Pessoa de Contacto, Contacto, Obs., após o preenchimento correcto do form, temos 2 opções, o registo, onde clicando no botao registo os dados inseridos sao copiados para uma folha de calculo existente para os respectivos campos, a outra opção é pesquisar! nao consigo por essa função a funcionar, ou seja, o que eu realmente pretendia era, clicar antes de mais era: digitar um nome no form inicial, clicar em pesquisar e se nao fosse encontrado na lista existente devolvia uma mensg de erro, se encontrasse o nome, preenchia o form com os restantes 10 campos referentes aos dados do contacto pesquisado.

Será que alguém me consegue ajudar??!!

Obrigado a todos!

Ricardo Martins

[jtiagodias]

Depois duma leitura muito rápida deixo-te o que me ocorreu, EM CONCEITO.

Penso que em primeiro lugar terás que fazer um ciclo for para pesquisares em todas as células correspondentes ao teu campo.

Depois poderás fazer um If comparando o que está escrito no campo do formulário com o que está na célula...

Isto foi o que me ocorreu para já.

Se conseguir logo à noite vou testar e depois digo algo.

Mas entretanto deve surgir alguém que te cosiga dar uma ajuda efectiva.

ehehehe

cump.

[vbtipo]

Usas um filtro para fazeres isso numa outra folha de excel onde guardas isso tudo....

[jpaulino]

Olá Ricardo Martins,

Peço desculpa por ainda não ter respondido ao email, mas são muitos e o tempo é pouco 😛

Relativamente à tua pergunta queres apenas a parte da pesquisa ?

E é total ou parcial ? (ou seja procurar pelo nome todo ou por parte do nome)

[rsmartins]

Ora Viva antes de mais agradeço a todos a prontidão na resposta!

Em resposta ao "jpaulino": compreendo a demora na resposta! serão certamente mais os pedidos que o tempo disponivel!

necessitava apenas do código para a parte da pesquisa uma vez que todo o resto está a funcionar na perfeição! a pesquisa deverá ser total, julgo que poderão existir nomes com partes iguais, assim conseguimos eliminar esse problema. já agora, será possivel pesquisar por mais do que um campo? tipo nome ou email ou cod. postal?

o ideal seria carregar em pesquisar no form inicial de inserção de dados, surgir um form novo de pesquisa com os campos q acharmos necessários, sendo que o nome seria chave, e ao clicar em ok/pesquisar nesse novo form, o resultado da pesquisa fosse returnado para o form inicial de inserção de dados permitindo assim 2 hipoteses, pesquisa e edição ao mesmo tempo.

Cumpts.

Ricardo Martins

[jpaulino]

O principio base da pesquisa é este (para pesquisar em várias worksheets em qualquer lado):

    Dim ws As Worksheet
    Dim currentWS As Worksheet
    Dim str As String
    Dim rg As Range
    
    Application.ScreenUpdating = False
    
    str = InputBox("Texto a pesquisar ...")
      
    Set currentWS = ActiveSheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Select
   
        Set rg = Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)
            
        If Not rg Is Nothing Then
             rg.Activate
             rg.Show
             Application.ScreenUpdating = True
             Exit Sub
        End If
    
   Next
   
   currentWS.Select
   Application.ScreenUpdating = True
   
   MsgBox "Texto não encontrado"

Vê se dá para teres a ideia e adaptar ao teu projecto. Se queres pesquisar por mais é só criares mais pesquisas.

Ou queres pesquisar apenas num range ?

PS: Está assim porque tirei este exemplo de uma outra resposta

[rsmartins]

Assim tá perfeito, faz a pesquisa direito! colei o codigo q enviaste com algumas personalizações no private sub do botao pesquisar e ao clicar no mesmo a pesquisa é feita, só que o resultado é apresentado na folha de cálculo onde estao inseridos os contactos e o ideal seria que os dados returnassem ao form de inserção!

Fiz-me entender?

Cumpts

RM

[jpaulino]

Entao so tens de substituir a activacao da celula

            rg.Activate

            rg.Show

Pelo resultado

            MsgBox rg.Value

            MsgBox rg.Offset(0, 1).Value ' mostra a coluna ao lado

[rsmartins]

OK, mas esse comando não preenche os campos do formulário principal de inserção de dados, apenas mostra o resultado da pesquisa numa janela de aviso! entendes a minha dúvida?

[jpaulino]

Então só tens de fazer:

Text1.Value = rg.Value

Text2.Value = rg.Offset(0, 1).Value

...

Ou estou errado ?

[rsmartins]

Mas onde coloco esse código? não estou a entender a tua ideia!! é que mesmo assim não consegues fazer o q eu pretendo! se quiseres posso enviar alguma coisa do meu trabalho para ser possivel uma análise mais certa!!

desculpa a insistência!

Cumpts

RM

[jpaulino]

Mas onde coloco esse código? não estou a entender a tua ideia!! é que mesmo assim não consegues fazer o q eu pretendo! se quiseres posso enviar alguma coisa do meu trabalho para ser possivel uma análise mais certa!!

desculpa a insistência!

Cumpts

RM

Sim, podes colocar o link aqui para o ficheiro ?

[rsmartins]

cá está ele!

https://www.yousendit.com/transfer.php?action=batch_download&send_id=655845612&email=d189da2edabf018fe395286e81d00ed1

repara q ao clicar no botao menu, surge um form de inserção de dados, faz um registo de um novo contacto preenchendo todos os campos, após isso verifica que os dados são inseridos na sheet AGENDA, depois no mesmo botao menu tens a opção pesquisar/editar, ao clicar surge a janela de pesquisa, inseres o nome a pesquisar, se encontrar, o resultado esperado e ideal seria preencher todos os campos de inserção de dados com os dados do contacto pesquisado, fiz-me entender? se nao encontra dá mensg de erro "contacto inexistente"!

Consegues implementar isso??

Mais uma vez obrigado!

Cumpts

RM

[jpaulino]

Ou entendi mal, ou o que tens que fazer é substituir as mensagems (msgbox) por

             Text_Nome.Value = Cells(rg.Row, "A").Value
             Text_Morada.Value = Cells(rg.Row, "B").Value

             ' continua para as outras textboxes

Deves também limpar os dados caso não encontre, ou seja:

If Not rg Is Nothing Then

  ' preenches os dados

Else

    Text_Nome.Value = ""

    ...

End If

[rsmartins]

Ficaria assim? Corrige se estiver errado!! o unico problema é que mesmo que encontre o campo que pesquisei devolve sempre a mensagem de erro de "Texto nao encontrado" e preenche os campos! como retiro isso?? de resto parece-me estar óptimo! dá uma vista de olhos no código a fim de verificar se está tudo em condições e de tentar retirar a mensagem de erro mesmo que encontre a pesquisa!

cumpts.

RM

Private Sub btnPesquisar_click()


    Dim ws As Worksheet
    Dim currentWS As Worksheet
    Dim str As String
    Dim rg As Range
   
    Application.ScreenUpdating = False
   
    str = InputBox("INSIRA O NOME A PESQUISAR")
     
    Set currentWS = ActiveSheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Select
   
        Set rg = Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)
            
            
           
        If Not rg Is Nothing Then

            
        
              Text_Nome.Value = Cells(rg.Row, "A").Value
              Text_Morada.Value = Cells(rg.Row, "B").Value
              Text_Codpostal.Value = Cells(rg.Row, "C").Value
              Text_Localidade.Text = Cells(rg.Row, "D").Value
              Text_Telefone.Text = Cells(rg.Row, "E").Value
              Text_Telemovel.Text = Cells(rg.Row, "F").Value
              Text_Fax.Text = Cells(rg.Row, "G").Value
              Text_Email.Text = Cells(rg.Row, "H").Value
              Text_Web.Text = Cells(rg.Row, "I").Value
              Text_Pessoacontactar.Text = Cells(rg.Row, "J").Value
              Text_Contacto.Text = Cells(rg.Row, "K").Value
              Text_Obs.Text = Cells(rg.Row, "L").Value
              
              Application.ScreenUpdating = True
              
              
              Else
              
                            
              Text_Nome.Value = ""
              Text_Morada.Value = ""
              Text_Codpostal.Value = ""
              Text_Localidade.Text = ""
              Text_Telefone.Text = ""
              Text_Telemovel.Text = ""
              Text_Fax.Text = ""
              Text_Email.Text = ""
              Text_Web.Text = ""
              Text_Pessoacontactar.Text = ""
              Text_Contacto.Text = ""
              Text_Obs.Text = ""
              
              End If
              
              
              Next
              
              currentWS.Select
              Application.ScreenUpdating = True
              
              
              MsgBox "O NOME PESQUISADO NÃO SE ENCONTRA REGISTADO NA BASE DE DADOS", vbExclamation
              
              End Sub

[jpaulino]

Colocas a msgbox a seguir a:

Text_Obs.Text = ""

[rsmartins]

OK.  feito e resolvido!

Mt obrigado pela preciosa ajuda!

Cumpts.

RM