Listbox sahifeden çok kriterli filtreleme

[kemal turan]

Merhaba,
Listview nesnesi sürüm ve bit farklılıklarından dolayı sorun çıkarmakta.
Benden istenen yaptığım küçük projelerde sıkıntı çıkmasından dolayı listview de çok krıterli arama kodlarında yapabildiklerimi "Aşağıdaki örnek listview kodlardaki gibi"
listbox dayapabileceğim kodları örnek dosyada verebilirseniz sevinirim.

Sub tahsıledıldı()
On Error Resume Next
Set Sr = Sheets("kasa")

ListView1.ListItems.Clear
ListView1.FullRowSelect = True
Dim i As Long
[CODE]Private Sub ComboBox2_Change()
If ComboBox2 = "" Then
Exit Sub
End If
Set Sr = Sheets("satış")
Sheets("satış").Columns.AutoFit ' EXCEL SAYFASINDAKİ SÜTUN GENİŞLİĞİNİ OTOMATİK AYARLAR
ListView1.ListItems.Clear
ListView1.FullRowSelect = True
Dim i As Long
Set Sr = Sheets("satış")
With ListView1
For i = 2 To Sr.Cells(65536, "A").End(xlUp).Row
If UCase(Replace(Replace(Sr.Cells(i, "AJ").Value, "ı", "I"), "i", "İ")) _
    Like "*" & ComboBox1.Value & "*" _
    And UCase(Replace(Replace(Sr.Cells(i, "AK").Value, "ı", "I"), "i", "İ")) _
    Like "*" & ComboBox2.Value & "*" Then
   .ListItems.Add , , Sr.Cells(i, "A")
        X = X + 1
    .ListItems(X).ListSubItems.Add , , Format(CDate(Sr.Cells(i, "D").Value), "DD.MM.YYYY")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "C")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "E")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "F")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "G")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "K")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "L")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "M")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "N")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "O")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "P")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "Q")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "R")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "AB")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "AF")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "AG")
    End If
Next i
End With
Set Sr = Nothing
toplamkota
End Sub

Set Sr = Sheets("KASA")

With ListView1
For i = 2 To Sr.Cells(65536, "a").End(xlUp).Row
If UCase(Replace(Replace(Sr.Cells(i, "v").Value, "ı", "I"), "i", "İ")) _
    Like "*" & "ÇEK" & "*" _
    And UCase(Replace(Replace(Sr.Cells(i, "s").Value, "ı", "I"), "i", "İ")) _
    Like "*" & "TAHSİL EDİLDİ" & "*" Then
   .ListItems.Add , , Sr.Cells(i, "A")
        X = X + 1
        
    .ListItems(X).ListSubItems.Add , , Format(Sr.Cells(i, "D"), "DD.MM.YYYY")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "f")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "ı")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "j")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "o")
    .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "p")
   .ListItems(X).ListSubItems.Add , , Format(Sr.Cells(i, "Q"), "#,##0.00")
   .ListItems(X).ListSubItems.Add , , Format(Sr.Cells(i, "R"), "DD.MM.YYYY")
   .ListItems(X).ListSubItems.Add , , Sr.Cells(i, "s")
    End If
   
Next i
End With
Set Sr = Nothing
TOPLAM
End Sub

 

[kemal turan]

Merhaba,
Soruyu sorduktan sonra araştırmaya devam ettim.
daha önce sorulan bir sorudaki kodu aşağıdaki şekilde uyarlamaya çalıştım.
Msgbox satırı devreye giriyor.
Örnek dosyayı revize ederek tekrar yükledim.
Teşekkür ederim.
MsgBox ComboBox3.Text & " Veri Tablosunda Yok! ", vbCritical

Private Sub TextBox4_Change()
Dim a As Long
    Dim i As Long
    ReDim dizial(1 To 9, 1 To 1)

    If ComboBox3.Text = "" Then Exit Sub
    ListBox1.Clear

    For i = 2 To [a65536].End(3).Row
        If TextBox4.Text = Cells(i, "e") And ComboBox3.Text = Cells(i, "c") And ComboBox4.Text = Cells(i, "d") Then
        
            a = a + 1
            ReDim Preserve dizial(1 To 9, 1 To a)
            dizial(1, a) = Cells(i, "A")
            dizial(2, a) = Cells(i, "B")
            dizial(3, a) = Cells(i, "C")
            dizial(4, a) = Cells(i, "D")
            dizial(5, a) = Cells(i, "E")
            dizial(6, a) = Cells(i, "F")
            dizial(7, a) = Cells(i, "G")
            dizial(8, a) = CDbl(Format(Cells(i, "H"), "0.00"))
            dizial(9, a) = Cells(i, "I")
            End If
            Next i
            If a = 0 Then
        MsgBox ComboBox3.Text & " Veri Tablosunda Yok! ", vbCritical
    Else
        ListBox1.Column = dizial
    End If

    Erase dizial
    a = Empty
    i = Empty
    Set SV = Nothing
End Sub

 

[Korhan Ayhan]

Bu şekilde yazma anında arama yapan kodlarda ile başlar yöntemini kullanırsanız daha sağlıklı sonuç alabilirsiniz. Dilerseniz arama işlemini içerir yöntemi olarak değiştirebilirsiniz.

Private Sub TextBox4_Change()
    Dim a As Long, i As Long
    
    ReDim dizial(1 To 9, 1 To 1)

    If ComboBox3.Text = "" Then Exit Sub
    ListBox1.Clear

    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        If UCase(Replace(Replace(Cells(i, "e"), "ı", "I"), "i", "İ")) Like _
        UCase(Replace(Replace(TextBox4.Text, "ı", "I"), "i", "İ")) & "*" And _
        ComboBox3.Text = Cells(i, "c") And ComboBox4.Text = Cells(i, "d") Then
        
            a = a + 1
            ReDim Preserve dizial(1 To 9, 1 To a)
            dizial(1, a) = Cells(i, "A")
            dizial(2, a) = Cells(i, "B")
            dizial(3, a) = Cells(i, "C")
            dizial(4, a) = Cells(i, "D")
            dizial(5, a) = Cells(i, "E")
            dizial(6, a) = Cells(i, "F")
            dizial(7, a) = Cells(i, "G")
            dizial(8, a) = CDbl(Format(Cells(i, "H"), "0.00"))
            dizial(9, a) = Cells(i, "I")
        End If
    Next i
    
    If a = 0 Then
        MsgBox ComboBox3.Text & " Veri Tablosunda Yok! ", vbCritical
    Else
        ListBox1.Column = dizial
    End If
    
    Erase dizial
    a = Empty
    i = Empty
End Sub

 

[kemal turan]

Merhaba Korhan hocam,
Uzun zamandır listbox da bu şekilde bir filtreleme bulamadığım için listview ile çalışıyordum.
Listview de 32 bit olsada her sürümde çalışmıyor, bir şekilde hata veriyordu.
Çok ciddi bir stok cari kasa projesine giriştim. Bu çözümünüz işimi kolaylaştıracak.
Alternatif olarak farklı bir sahifeye gelişmiş filtre ile çözmek en son çaremdi. bu da sahie sayısını çoğaltacaktı.
Sonsuz teşekkürler.
Başlangıç aşamasında olan proje dosyamı paylaşıyorum. Sadece "KAYITLAR" seçeneğinde birşeyler yaptım.
Eleştiri ve önerileriniz için teşekkür ederim.
Kullanıcı : KEMAL
ŞİFRE= 1234

 

[Korhan Ayhan]

Aslında forumda benzer kodlamalar var. Sanırım siz bulamadınız.

 

[kemal turan]

Çok teşekkür ederim.
Selametle kalınız.

 

[mehmetsebihnibak]

MERHABA KEMAL BEY MERHABA DİĞER ARKADAŞLAR; BEN BİR EVRAK KAYIT PROGRAMI YAPTIM FAKAT SON BİR İŞ KALDI ONUDA BECEREMİYORUM. BANA YARDIMCI OLURSANIZ SEVİNİRİM. ŞÖYLEKİ İKİ ADET USEFORM VAR BİRİ KAYIT İÇİN DİĞERİDE LİSTBOXDAKİ VERİLERİ DÜZNLEME VE FİLTRELEME İÇİNDİR. TABLOMUN BULUNDUĞU EXCEL SAYFASINI GİZLEMİŞİM KAYITLAR LİSTBOXDA GÖRÜNÜYOR FAKAT LİSTBOXUN YANINDAKİ VE ÜSTÜNDEKİ FİLRELEME BUTONLARINDA EVRAK SAYI NUMARSI VEYA TARİH İLE FİLRE YAPTIĞIMDA LİSTBOX VERİ GETİRMİYOR.
NOT: GİZLENMİŞ SAYFAYI GÖSTERDİĞİMDE FİLTRELER ÇALIŞIYOR GİZLEDİĞİMDE ÇALIŞMIYOR. SELAMLAR SAYGILAR.