Userformda texbox ile listbox süzme kodunda düzeltme

[cems]

Bir üyenin dosyasını geliştirirken takıldığım nokta olarak ;

Userform multipage üzerinde veri sayfasında girilen datanın ikinci sayfada kritere göre süzülmesi , süz adı verilen bir sayfaya istenirse aktarılması, verinin iki tarih arasında da ayrıca süzülmesi ve textboxlar boşaldığında listboxta verinin tam olarak geri getirilmesi gereklidir.

Kodları bir çok şekilde denesem de süzmenin neden sıfır liste ile sonuçlandığını artık kafa durduğundan yakalamak mümkün olmadı.

textbox123 için kodların düzeltilmesi gerçekleştiğinde sanırım diğer textbox süzmelerini devam ettirebilirim .

Hatamın ne olduğunu düzelterek gösterir misiniz ?

 

[Korhan Ayhan]

Merhaba,

Süzme işleminde ilk olarak ListBox2.RowSource = "" komutu ile liste kutusunu temizlemişsiniz. Fakat süzme işlemini sayfada yaptırdıktan sonra tekrar oluşan listeyi liste kutusuna yüklememişsiniz. Sorun bundan kaynaklanıyor.

 

[cems]

Merhaba,

Süzme işleminde ilk olarak ListBox2.RowSource = "" komutu ile liste kutusunu temizlemişsiniz. Fakat süzme işlemini sayfada yaptırdıktan sonra tekrar oluşan listeyi liste kutusuna yüklememişsiniz. Sorun bundan kaynaklanıyor.

Sayın Ayhan,
Sorunun kaynağını anlamakla beraber , düzeltmeyi duran akıl ile oluşturamıyorum

Private Sub TextBox123_Change()

Dim sh As Worksheet, sat As Long
Set sh = Sheets("tablo")
sat = sh.Cells(sh.Rows.Count, "a").End(xlUp).Row
ListBox2.RowSource = ""
Application.ScreenUpdating = False
sh.Range("C1").AutoFilter
sh.Range("$A$1:$M$65536").AutoFilter Field:=3, Criteria1:=TextBox123.Text & "*"
ListBox2.RowSource = "tablo!a2:m65536" & sat

If TextBox123 = "" Then
sh.Range("a1:m65536").AutoFilter Field:=3              ', Criteria1:=TextBox123.Text & ""
           'sh.Range("C4").CurrentRegion.Offset(2, 0).Copy Sheets("SUZ").Range("C4")
ListBox2.RowSource = "tablo!a2:m65536" & sat
End If
End Sub

Öneriniz ne olabilir ?

 

[Korhan Ayhan]

Dosyanıza RAPOR isminde bir sayfa ekleyiniz.

Daha sonra aşağıdaki kodu deneyiniz.

Private Sub TextBox123_Change()
    Dim S1 As Worksheet, S2 As Worksheet, Satir As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("TABLO")
    Set S2 = Sheets("RAPOR")
    
    If TextBox123 <> "" Then
        ListBox2.RowSource = ""
        S2.Cells.Delete
        S1.Range("C1").AutoFilter
        S1.Range("A1:M" & S1.Rows.Count).AutoFilter Field:=3, Criteria1:=TextBox123.Text & "*"
        S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
        S1.Range("A2:M" & S1.Rows.Count).AutoFilter Field:=3
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
        ListBox2.RowSource = "RAPOR!A2:M" & Satir
    Else
        S1.Range("A2:M" & S1.Rows.Count).AutoFilter Field:=3
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
        ListBox2.RowSource = "TABLO!A2:M" & Satir
    End If
    
    Application.ScreenUpdating = True
End Sub

RAPOR sayfasındaki verileri formun kapanışında silmek için aşağıdaki kodu kullanabilirsiniz.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Sheets("RAPOR").Range("A2:M" & Rows.Count).Clear
End Sub

 

[cems]

Sayın Ayhan ,

Kodları okurken , nasıl bunu atladım diye düşünmeden edemiyor insan . Rapor sayfasını da kodlamışsınız.

Gece saatlerinde deneyerek sonucu yazacağım , çok teşekkür ederim . Bir yerden sonra insan da " out of range " oluyor

 

[cems]

Sayın Ayhan ,

Kodları okurken , nasıl bunu atladım diye düşünmeden edemiyor insan . Rapor sayfasını da kodlamışsınız.

Gece saatlerinde deneyerek sonucu yazacağım , çok teşekkür ederim . Bir yerden sonra insan da " out of range " oluyor

Sayın Ayhan ,

Süzme kodları kusursuz çalıştı ve rapor sayfasına da süzüldüğü hali ile aktardı. Tekrar göz nurunuz için çok teşekkür ederim