Süzme sorunu

[acemiler]

Gönderdiğim dosyadaki form'da (siteden alarak değişiklik yaptım) textbox veri girildikten sonra enter tuşuna basılınca veriyi arıyordu. Textbox'un yanına commmandbutton ekleyerek (içerir şartıyla)veriyi taratıyorum. Formda bölge yazan textbox'a "bilgisayar" yazıp süzdükten sonra alt bölge yazan textbox'a "ss" yazdığımda bölge kısmındaki şart olan bilgisayar silinip yerini "İstanbul" verisi alıyor. Benim istediğim ilk şarta uygun olarak ikinci süzmeyi yapması. İnşallah anlatabilmişimdir. Teşekkürler.

 

[janveljan]

Kodların ilgili kısımlarını aşağıdaki şekilde değiştirip deneyin.

Private Sub CommandButton401_Click()
If Trim(TextBox1.Value) = "" Then: ListeGuncelle: Exit Sub
Set Sh = Sheets("HOTELS")
Ara = "*" & TextBox1.Value & "*"
Set bulunacak = Sh.Range("A:A").Find(Ara) 'VERİ HANGİ SÜTUNDA ARANACAK
If Not bulunacak Is Nothing Then
Adres = bulunacak.Address
ListView1.ListItems.Clear
Do
sat = bulunacak.Row
If Sh.Cells(sat, "B") Like ("*" & TextBox2.Value & "*") Then
With ListView1
.ListItems.Add , , Sh.Cells(sat, 1)
X = X + 1
With .ListItems(X).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
.Add , , Sh.Cells(sat, 2)
.Add , , Sh.Cells(sat, 3)
.Add , , Sh.Cells(sat, 4)
.Add , , Sh.Cells(sat, 5)
.Add , , Sh.Cells(sat, 6)
.Add , , Sh.Cells(sat, 7)
.Add , , Sh.Cells(sat, 8)
.Add , , Sh.Cells(sat, 9)
.Add , , Sh.Cells(sat, 10)
.Add , , Sh.Cells(sat, 11)
.Add , , Sh.Cells(sat, 12)
.Add , , Sh.Cells(sat, 13)
.Add , , sat
End With
End With
End If
Set bulunacak = Sh.Range("A:A").FindNext(bulunacak)
Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
Else
MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
TextBox1.Value = ""
ListeGuncelle
End If
End Sub

Private Sub CommandButton402_Click()
CommandButton401_Click
End Sub