Ir para conteúdo
Fórum Script Brasil
  • 0

Problemas com Pesquisar com filtros de pesquisa em VBA


Pedro Miguel Gomes

Pergunta

Sou estudante de Programação e nunca tinha usado VBA e tenho de entregar um trabalho, mas nunca tive formação nesta linguagem, e estou a ter problemas  no programa na parte de Pesquisar registros com filtros, já tentei ao máximo fazer seguindo tutoriais na internet, até que uma pessoua me ajudou e mandou-me codia e disse para fazer um passos só que eu não sei seguir esses passos.

 Fico muito agradecido se alguém me conseguir ajudar.

   

O que a pessoa me indicou:

" Para testar o código coloque um filtro na planilha Dados no range A1:L1 e crie uma planilha com o nome de Auxiliar. Cole o código no formulário Pesquisar. "

Option Explicit

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then Call Filtro(TextBox1.Text, ComboBox1.Text)
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then Call Filtro(TextBox2.Text, ComboBox2.Text)
End Sub

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then Call Filtro(TextBox3.Text, ComboBox3.Text)
End Sub

Private Sub UserForm_Initialize()
    ComboBox1.RowSource = "Relatório!A1:A12"
    ComboBox2.RowSource = "Relatório!A1:A12"
    ComboBox3.RowSource = "Relatório!A1:A12"
End Sub

Sub Filtro(ByVal Pesquisa As String, Campo As String)
    Dim Coluna  As Integer
    Dim Area    As Range
    
    Set Area = ThisWorkbook.Sheets("Dados").[A1:L1]
    Coluna = WorksheetFunction.Match(Campo, Area, 0)
    If Pesquisa <> "" Then
        If IsNumeric(Pesquisa) = False Then Pesquisa = "*" & Pesquisa & "*"
        Call Area.AutoFilter(Field:=Coluna, Criteria1:=Pesquisa)
        Call CopiaTabela
        Call PreencheListBox
    End If
End Sub

Sub CopiaTabela()
    ThisWorkbook.Sheets("Auxiliar").[A:L].Clear
    ThisWorkbook.Sheets("Dados").[A1].CurrentRegion.Copy
    ThisWorkbook.Sheets("Auxiliar").[A1].PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Sub PreencheListBox()
    Dim Area    As Range
    Set Area = ThisWorkbook.Sheets("Auxiliar").[A1].CurrentRegion
    ListBox1.ColumnCount = Area.Columns.Count
    ListBox1.ColumnHeads = True
    ListBox1.RowSource = "Auxiliar!" & Area.Offset(1).Address
End Sub

Link do Programa: 

https://drive.google.com/file/d/1ucJVL5Ijg0IcDqaFzoJi8aiMPb0NCbjI/view?usp=sharing

Link para o comentário
Compartilhar em outros sites

5 respostass a esta questão

Posts Recomendados

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...