Listboxta textbox ile tarih süzme hatası

[cems]

Ekte bulunan çalışmada ;

Amaç : Yüksek sayılı personeli bulunan bir işletmede giriş bariyer dökümlerinin userform üzerinde textboxlar yardımı ile süzülerek günlük haftalık ve aylık gözetim yapmaktır. Yani liste oldukça uzayacaktır.

Özellik: Çalışma 2 sayfadan oluşmakta, birinci sayfada veri girişi , düzeltilmesi silinmesi işlemi , ikinci sayfada da filtre olarak kullanılan textboxlar ile süzme ve istenirse süzülen verinin basımının alınmasıdır.

Sorun: Textboxlar default olarak metin hissederler, bunların tarih ya da saat hissetmesi için format eklemek gereklidir. Bu çalışmada sorun , süzme sayfasındaki tarih textboxunu bir çok şekilde denesem de formatlama oluşmadı, dolayısı ile tarihe göre listeleme hatalı. Diğer textboxlar metine dayandığından sorun yok.

Süzme ve baskı sayfasına atma konusunda Sn Haluk'un şu kodları kullanılmıştır.

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

Talep : tarih süzme textboxundaki kodlarda tarihe göre listboxta doğru liste verecek formatı oluşturmak. Zira tarihe göre süzme , aslında çalışmanın kilit isteğidir.

Bunun için yukarıdaki kodları nasıl revize etmek gerekir ?

http://www.filebig.net/files/sFeGBMwini

 

[Korhan Ayhan]

Deneyiniz.

Private Sub TextBox125_Change()
    Dim S1 As Worksheet, S2 As Worksheet, Satir As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("TABLO")
    Set S2 = Sheets("RAPOR")
    
    If TextBox125 <> "" And Len(TextBox125) = 10 Then
        ListBox2.RowSource = ""
        S2.Cells.Delete
        S1.Range("D1").AutoFilter
        S1.Range("A1:N" & S1.Rows.Count).AutoFilter Field:=4, Criteria1:=Format(CDate(TextBox125.Value), "dd.mm.yyyy")
        S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
        S1.Range("A1:N" & S1.Rows.Count).AutoFilter Field:=4
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
        ListBox2.RowSource = "RAPOR!A2:N" & Satir
    Else
        S1.Range("A1:N" & S1.Rows.Count).AutoFilter Field:=4
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
        ListBox2.RowSource = "TABLO!A2:N" & Satir
    End If
    
    Application.ScreenUpdating = True
End Sub

 

[Ömer BARAN]

Merhaba.

Mevcut kodlarınızda değişiklik yapmamak için, UserForm'da tarih filtresi için kullanılan TextBox'un adını değiştirdim (TextBox1251 yaptım) ve
bu ada göde userform kodlarının en altına kodlar ekledim (forumdan edinilmiş kodlardır, yanılmıyorsam Sayın Korhan AYHAN'ın kodları idi)

Sanırım istediğiniz gibi oldu.
Filtrenin aktive olması için TextBox'tan Enter veya başka bir nesne seçilerek çıkılması gerekir.

Dikkat:
-- TextBox'a tarih girerken . veya / karakteri otomatik eklenir,
-- harf yazılamaz,
-- anlamsız tarih yazılmamasına yönelik bazı kontroller var.
.

 

[cems]

Sayın Ayhan ,

Önerdiğiniz kodları denedim , ilk anda diğer kutular gibi her dijitte süzüleceği beklentisi ile süzülmediğini düşündüm. Textboxta format unutup unutmadığımdan , initialize'de kalmış açılışta format olup olmadığından da emin oldum . Yine de süzülmedi.

Ancak , kodlar içinde "Len" bulunduğu gözüme çarptı ve tarihi tam olarak girdim.

Oldukça sağlıklı olarak süzme gerçekleşti .

Yukarda koyulaştırma, bu kodu kullanmak isteyecek arkadaşların dikkatini çekmek için...

Çalışmanın belkemiği sayenizde oluştu , çok teşekkür ederim

Sayın Baran , notunuzu ve ek dosyayı şimdi farkettim , inceleyerek bilgi vereceğim .

 

[cems]

Sayın BARAN ,

Dosya üzerine eklemiş olduğunuz kodları inceledim , daha farklı bir düşünce yolu .

Kontroller düşünmediğim bir şeydi , gerçekten bu ayrıntı önemli ve hepsini bulmuş oldum.
Çalışmayı denedim, yine otomatik her dijitle süzme beklentisi yaşadım ancak tam yazdıktan sonra -enter- ile çalıştığını gördüm.

Textbox değiştiğinde sorunsuz bir şekilde süzme gerçekleşti.

Tek sorun, tarih textboxu boşaltıldığında liste süzmeden çıkmıyor, tam liste gelmiyor. Kodlarda bu noktada değişiklik de bu anlamda göremedim , sebebini anlamadım.

Her ne kadar Sayın Ayhan'ın kodları konuyu çözmüş olsa da , bu kod yapısını da vba sözlüğüme yüklemek isterim ; eğer vaktiniz olur inceleyebilirseniz ...

 

[Ömer BARAN]

TextBox_Change kodu'nun baş kısmına kırmızı renklendirdiğim kısımlar eklenerek olabilir.
.

Dim Uzunluk As Integer
[COLOR="Red"]Dim S1 As Worksheet, S2 As Worksheet, Satir As Long
        
Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")
[/COLOR]
With TextBox1251
    .MaxLength = 10
    Uzunluk = Len(.Value)
    
[COLOR="red"]If Uzunluk < 10 Then
    Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
    ListBox2.RowSource = "[B]TABLO[/B]!A2:N" & Satir
End If[/COLOR]
    
    If Kontrol Then

 

[cems]

Sabahleyin , ilk olarak bu düzeltmeleri deneyecek ve tekrar geribilgi vereceğim

Sayın Ayhan , Sayın Baran ;

Bu çalışmanın çözülmesinde verdiğiniz destek için çok teşekkür ederim . Tekrar sağolun.

 

[cems]

Sayın Baran ;

Textbox boşaltıldığında listbox listesinin tekrar açılması ile ilgili eklemiş olduğunuz düzeltmeleri denedim , hiç sorunsuz olarak istendiği gibi çalıştı.

Sn Baran Sn Ayhan ,

Tekrar çok teşekkür ederim, elinize sağlık.