textbox ile listbox da veri sıralama(süzme)

[Ergün GÖKER]

Herkese merhabalar konu kapanalı baya uzun bir süre olmuş umarım textbox ile listbox da veri sıralama(süzme) konusunda bana yardımcı olunur. yapmak istediğim ustalara anlatmaya gerek yok açılacak listbox listesi birbirine girdi ve düzeltemiyorum. yardım bekliyorum. Şimdiden herkese teşekkürler.
Birde sayfa kapatırken kayıt yapıyor vs . bunun kaldırılması mümkün mü ?

 

[Orion1]

Herkese merhabalar konu kapanalı baya uzun bir süre olmuş umarım textbox ile listbox da veri sıralama(süzme) konusunda bana yardımcı olunur. yapmak istediğim ustalara anlatmaya gerek yok açılacak listbox listesi birbirine girdi ve düzeltemiyorum. yardım bekliyorum. Şimdiden herkese teşekkürler.
Birde sayfa kapatırken kayıt yapıyor vs . bunun kaldırılması mümkün mü ?

Dosyanız ektedir.

Private Sub liste()
Dim i As Long, sonsat As Long, sh As Worksheet
ListBox1.Clear
Set sh = Sheets("FİHRİST")
sonsat = sh.Cells(Rows.Count, "C").End(xlUp).Row
For i = 12 To sonsat
    ListBox1.AddItem
    ListBox1.List(i - 12, 0) = sh.Cells(i, "C").Value
    ListBox1.List(i - 12, 1) = sh.Cells(i, "D").Value
    ListBox1.List(i - 12, 2) = sh.Cells(i, "E").Value
    ListBox1.List(i - 12, 3) = sh.Cells(i, "G").Value
    ListBox1.List(i - 12, 4) = sh.Cells(i, "H").Value
    ListBox1.List(i - 12, 5) = sh.Cells(i, "K").Value
    ListBox1.List(i - 12, 6) = sh.Cells(i, "O").Value
Next i
End Sub

 

[Ergün GÖKER]

sayın Orion öncelikle ilginize teşekkür ederim ama yazılan bir kodda hata veriyor. ve çalışmıyor. sanırım ben sorunumu anlatamadım yada yanlış anlattım . süzme yaptıktan sonra hata veriyor. Error 1004 veriyor.Arama listbox ta düzgün görünmüyor. sağa kaymış halde görünüyor. Teşekkürler

 

[Ergün GÖKER]

resim ekledim

hocam bende nasıl açıldığı ve hata vermesi ayrıca nasıl olması istediğimle ilgili dosya resim ekliyorum birde çalışmamın bir orjinalini koyuyorum eğer bakma şansınız olursa çok sevinirim. şimdiden teşekkürler

 

[Ergün GÖKER]

Yapmak istediğim

Hocam yapmak istediğim dosya EVRAK yazan dosyadır FİHRİST olan sadece çalışma yaptığım Şimdiden Teşekkürler

 

[Orion1]

hocam bende nasıl açıldığı ve hata vermesi ayrıca nasıl olması istediğimle ilgili dosya resim ekliyorum birde çalışmamın bir orjinalini koyuyorum eğer bakma şansınız olursa çok sevinirim. şimdiden teşekkürler

Benim yazdığım kodlar süzme için değildi.Sadece userformunun ilk açılışında çalışan kodlar idi.textboxlarda süzme yaparken intializinde olayında yaptığım için call ile modülün en altına yazdığım kodu kullanın.Textboxların içinde yazmış olduğunuz diğer kodları silin.

 

[Ergün GÖKER]

Hocam kusuruma bakmayın textboxların içindeki bütün kodlarımı silicem, sildiğim zaman süzme yaparmı tam bir excell kullanıcısı olmadığım için soruyorum hocam

 

[Orion1]

textboxlara değer girerek süzme yapabilirsiniz.
Dosyanız ektedir.

Sub lst(ByVal nesne As Object, alan As range)
Dim k As range, adrs As String, j As Byte, a As Long, sh As Worksheet
ReDim myarr(0 To 6, 0 To 65535)
ListBox1.Clear
Set sh = Sheets("FİHRİST")
If nesne.Text = "" Then
Call liste
Exit Sub
End If
With Worksheets("FİHRİST")
    If .FilterMode Then .ShowAllData
    Set k = alan.Find("*" & nesne & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            myarr(0, a) = sh.Cells(k.Row, "C").Value
            myarr(1, a) = sh.Cells(k.Row, "D").Value
            myarr(2, a) = sh.Cells(k.Row, "E").Value
            myarr(3, a) = sh.Cells(k.Row, "G").Value
            myarr(4, a) = sh.Cells(k.Row, "H").Value
            myarr(5, a) = sh.Cells(k.Row, "K").Value
            myarr(6, a) = sh.Cells(k.Row, "O").Value
            a = a + 1
            Set k = alan.FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        Set sh = Nothing
        ReDim Preserve myarr(0 To 6, 0 To a)
        ListBox1.Column = myarr
        Erase myarr
    End If
End With
End Sub

 

[Ergün GÖKER]

hocam öncelikle teşekkürler. gösterdiğiniz ilgiden dolayı. Sizlere zahmet veriyorum. Evrakın tarihi aramasında bir sorun var ve evrak kayıt numarasını veriyor. Bir sorum daha olacak affınıza sığınarak arama yaptığımız yerdeki boşluk kadar sonuçların yazıldığı boşluk yerlerinin ölçüsünün aynı olma şansı varmı zahmet veriyorum şimdiden teşekkürler

 

[Orion1]

hocam öncelikle teşekkürler. gösterdiğiniz ilgiden dolayı. Sizlere zahmet veriyorum. Evrakın tarihi aramasında bir sorun var ve evrak kayıt numarasını veriyor. Bir sorum daha olacak affınıza sığınarak arama yaptığımız yerdeki boşluk kadar sonuçların yazıldığı boşluk yerlerinin ölçüsünün aynı olma şansı varmı zahmet veriyorum şimdiden teşekkürler

Ben kodlamamda boş sütunları almadım.sadece veri olan sütunları aldım.
Diğer konuya şimdi bakıcam.

 

[Ergün GÖKER]

hocam süpersin çok çok teşekkür ederim allah sizden razı olsun. Sizi sıkıyor olabilirim. Ama 01 ocaktan itibaren evrakları bu yeni yaptığım projeye monte etmeye çalışıyorum bu çok işime yarayacağı için işi gücü bıraktım bununla uğraşıyorum hakkınızı helal edin

 

[Orion1]

48 nolu mesajda dosyayı güncelledim.Oradan indirebilirsiniz.

 

[Ergün GÖKER]

Dosya hakkında

Hocam sütun boşluklarını gönderdiğim resimdeki gibi düzeltmek mümkünmüdür ?

 

[Orion1]

Hocam sütun boşluklarını gönderdiğim resimdeki gibi düzeltmek mümkünmüdür ?

dosyayı 48 nolu mesajda güncelledim.Oradan indirebilirsiniz.

ListBox1.ColumnWidths = "70;100;210;200;150;115"

 

[Ergün GÖKER]

yemin ederim. büyüksün hocam. allah sizden razı olsun parmakların dert görmesin. iyiki sizi tanımışım. Abi dememin mahsuru yoksa, abi bir isteğin bir arzun olursa emrindeyim herzaman

 

[Orion1]

yemin ederim. büyüksün hocam. allah sizden razı olsun parmakların dert görmesin. iyiki sizi tanımışım. Abi dememin mahsuru yoksa, abi bir isteğin bir arzun olursa emrindeyim herzaman

Estafurullah.
İyi geceler.
Ben kaçtım.

 

[Ergün GÖKER]

teşekkür abi allaha emanet ol