dimanche 8 mai 2022

TEXTBOX and CheckBox Filter Userform VBA

I'm stuck on a project. I have a project where my filter works with wildcard in the search. And I need Checkbox to work together with it. I believe my IF has a problem but I'm not able to elaborate a rationale if someone can help me with my project I'm very grateful My code is like this... I'm from Brazil and I'm having trouble solving this issue. If anyone can help me I would be very grateful!

Dim linhaa, linalist As Interior
Dim Valor_celula As String
Dim Criterio1, Cirterio2, Criterio3, Cirterio4 As String
Dim i As Long

'limpar filtro
frmMenu.lstvTeste.ListItems.Clear
ThisWorkbook.Sheets(2).Cells.ClearContents


'Apliocando o filtro 1
Select Case ComboBox1

'Empresa
Case ThisWorkbook.Sheets(1).Range("a2").Text
colunac1 = 0

'Tipo de Informação
Case ThisWorkbook.Sheets(1).Range("a3").Text
colunac1 = 1

'Resposta da Informação
Case ThisWorkbook.Sheets(1).Range("a4").Text
colunac1 = 2

Case ThisWorkbook.Sheets(1).Range("a5").Text
colunac1 = 3

Case ThisWorkbook.Sheets(1).Range("b6").Text
colunac1 = 4

End Select

If frmMenu.ComboBox2.Value = "" Then
colunac1 = 3
End If

'-----------------------------------------
'Apliocando o filtro 2
Select Case ComboBox2

'Empresa
Case Planilha1.Range("b2").Text
colunac2 = 1

'Tipo de Informação
Case Planilha1.Range("b3").Text
colunac2 = 2

'Resposta da Informação
Case Planilha1.Range("b4").Text
colunac2 = 3

End Select

If frmMenu.ComboBox2.Value = "" Then
colunac2 = 2
End If

'---------------------------------------------
ThisWorkbook.Activate

Planilha1.Select
plan = Planilha1.Name

Dim LinhaListbox, linha As Long

LinhaListbox = 1
linha = 2

Ln = 1

Dim ultimalinha As Range
Set ultimalinha = Planilha1.Range("a100000").End(xlUp)

With Sheets(plan)

Valor_celula = .Cells(linha, 2).Value


'---------------------teste---------------------------------------
**Do While linha <= ultimalinha.Row And _
 .Cells(linha, 2).Value <> ""
Valor_celula = .Cells(linha, 2).Value
'---------------------------------Alinhamento de criterios--------------------------------
'Criterio 1 GRSA ALIMENTAÇÃO
If frmMenu.chk1GRSA_ALIMENTAÇÃO.Value = True Then
Criterio1 = "GRSA ALIMENTAÇÃO"
Else
Criterio1 = "FALSE"
End If
'Criterio 2 GR MANUTENÇÃO
If frmMenu.chk2GR_MANUTENÇÃO.Value = True Then
Criterio2 = "GR MANUTENÇÃO"
Else
Criterio2 = "FALSE"
End If
'Criterio 3 FOODBUY
If frmMenu.Chk3FOODBUY.Value = True Then
Criterio3 = "FOODBUY"
Else
Criterio3 = "FALSE"
End If
'Criterio 4 GR CLEANMALL
If frmMenu.chk4CLEEAN_MALL.Value = True Then
Criterio4 = "CLEAN MALL"
Else
Criterio4 = "FALSE"
End If
'----------------------------------FIM ALINHAMENTO CRITERIOS----------------------------------
If UCase(Cells(linha, colunac1)) Like UCase("*" & (TxtBoxCampoPesquisa & "*")) And _
UCase(Cells(linha, colunac2)) Like UCase("*" & (TextBox2 & "*")) And _
UCase(Left(Valor_celula, Len(Criterio1))) = UCase(Criterio1) _
Or UCase(Left(Valor_celula, Len(Criterio2))) = UCase(Criterio2) _
Or UCase(Left(Valor_celula, Len(Criterio3))) = UCase(Criterio3) _
Or UCase(Left(Valor_celula, Len(Criterio4))) = UCase(Criterio4) _
Then
'
'Carrega informação para ListView
Set li = Me.lstvTeste.ListItems.Add(Text:=Planilha1.Cells(linha, 1))
li.ListSubItems.Add Text:=Planilha1.Cells(linha, 2)
li.ListSubItems.Add Text:=Planilha1.Cells(linha, 3)
li.ListSubItems.Add Text:=Planilha1.Cells(linha, 4)
li.ListSubItems.Add Text:=Planilha1.Cells(linha, 5)
End If
linha = linha + 1
Loop**
End With

End Sub```

  [1]: https://i.stack.imgur.com/eCLIv.png



Aucun commentaire:

Enregistrer un commentaire