Jump to content
Fórum Script Brasil
  • 0

Problemas com Pesquisar com filtros de pesquisa em VBA


Question

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 to post
Share on other sites

5 answers to this question

Recommended Posts

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      149151
    • Total Posts
      645419
×
×
  • Create New...