ListBox ta filtreleme

[mbattal]

Arkadaşlar Merhaba,
Forumda arama yaptım birçok konuyu inceledim fakat hiçbirini benim dosyama uyarlayamadım. O yüzden sizlere başvuyorum kusura bakmayın.
Sorumu ekteki dosyamda açıkladım
Yardım ederseniz çok sevinirim

 

[Orion1]

Dosyanız ekte.

Private Sub ListBox1_Click()
If ListBox1.ListCount > 0 Then TextBox2.Text = ListBox1.Value
    
End Sub

Private Sub TextBox1_Change()
Dim myarr() As String, k As Range, adr As String, a As Long
ReDim myarr(1 To 1, 1 To 1)
ListBox1.RowSource = vbNullString
Set k = Range("A:A").Find(TextBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 1, 1 To a)
        myarr(1, a) = k.Value
        Set k = Range("A:A").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    ListBox1.Column = myarr
End If
Erase myarr
Set k = Nothing
End Sub

 

[mbattal]

Sayın Evren Gizlen,
Cevabınızı ve çözümünüzü aldım çok teşekkür ederim
Elinize,Beyninize,gözünüze sağlık
Saygılarımla

 

[Orion1]

Sayın Evren Gizlen,
Cevabınızı ve çözümünüzü aldım çok teşekkür ederim
Elinize,Beyninize,gözünüze sağlık
Saygılarımla

Rica ederim.
İyi çalışmalar.

 

[kamiloğlu]

Evren Bey sizin cevabınızda aranan ile verinin uyuşması gerekiyor. Peki arama, verilerin herhangi bir yerindeki harfe veya sayıya göre nasıl yapılabilir. Ayrıca B, C sütununlarında da veri olduğunu farzedersek listelenen veriye çift tıkladığımızda B, C sütünundaki devamı textboxlarda nasıl görüntülenir..

 

[Orion1]

Hepsini içerir şeklinde armak için ilgili kodu aşağıdaki ile değiştiriniz.

Set k = Range("A:A").Find([B][COLOR="Red"]"*" &[/COLOR][/B] TextBox1.Text & "*", , xlValues, xlWhole)

 

[Orion1]

Evren Bey sizin cevabınızda aranan ile verinin uyuşması gerekiyor. Peki arama, verilerin herhangi bir yerindeki harfe veya sayıya göre nasıl yapılabilir. Ayrıca B, C sütununlarında da veri olduğunu farzedersek listelenen veriye çift tıkladığımızda B, C sütünundaki devamı textboxlarda nasıl görüntülenir..

Aşağıdaki gibi düzenledim.
ABC sütunlarınıda listeler ve hepsini içerir şeklinde listeler.
Yalnız listboxın ColumCount özelliğini 3 yapmayı unutmayın.

Private Sub TextBox1_Change()
Dim myarr() As String, k As Range, adr As String, a As Long
ReDim myarr(1 To 3, 1 To 1)
ListBox1.RowSource = vbNullString
Set k = Range("A:A").Find("*" & TextBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 3, 1 To a)
        myarr(1, a) = k.Value
        myarr(2, a) = k.Offset(0, 1).Value
        myarr(3, a) = k.Offset(0, 2).Value
        Set k = Range("A:A").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    ListBox1.Column = myarr
End If
Erase myarr
Set k = Nothing
End Sub

 

[kamiloğlu]

maşallah bu ne hız böyle.. anında cevap.. lütfen dosyanızıda ekleyebilirmisiniz...

 

[Orion1]

maşallah bu ne hız böyle.. anında cevap.. lütfen dosyanızıda ekleyebilirmisiniz...

Örnek dosyayı inceleyiniz.

 

[HD1975]

Merhaba

Aşağıdaki gibi düzenledim.
ABC sütunlarınıda listeler ve hepsini içerir şeklinde listeler.
Yalnız listboxın ColumCount özelliğini 3 yapmayı unutmayın.

Private Sub TextBox1_Change()
Dim myarr() As String, k As Range, adr As String, a As Long
ReDim myarr(1 To 3, 1 To 1)
ListBox1.RowSource = vbNullString
Set k = Range("A:A").Find("*" & TextBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 3, 1 To a)
        myarr(1, a) = k.Value
        myarr(2, a) = k.Offset(0, 1).Value
        myarr(3, a) = k.Offset(0, 2).Value
        Set k = Range("A:A").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    ListBox1.Column = myarr
End If
Erase myarr
Set k = Nothing
End Sub

Yukarıdaki kodu kullandım ama tam olmuyor.

Benim verilerimde I sütunu dahil veriler var ve ben B,F,G,I sütunlarında filtreleme yapmak istiyorum.
Yukarıdaki kodu düzenleyebilirimisiniz.

Bu arada G sütunu tarih içeriyor diğerleri metin.

Saygılar

 

[Orion1]

Hangi sütunda sorgulama yapacaksınız?

 

[HD1975]

Merhaba

Hangi sütunda sorgulama yapacaksınız?

A ve I dahil sütunlar var .

a : Kişi NO
b : Adı
c : Adresi
d : tel1
e : tel2
f : not
g : randevu tarihi
h : işlem tarihi
ı : Kullanıcı ismi

B,F,H,I sütunlarına göre textbox ekleyip filtreleme yaptırmak istiyorum.

B,F sütunu metin,H sütunu tarih,I sütunu ise metin ama nokta gibi karakterler
içeriyor. (C:\Administrator)

Saygılar

 

[Orion1]

Tamamda kişi noya göremi ada göremi arma yapacaksınız.

 

[HD1975]

Pardon

Kişi No'ya göre arama yapacağız.:biggrin:

 

[Orion1]

Kişi No'ya göre arama yapacağız.:biggrin:

Kodları düzenledim.Aşağıdaki kodları kullanabilirsiniz.

Private Sub TextBox1_Change()
Dim myarr() As String, k As Range, adr As String, a As Long
ListBox1.ColumnCount = 9
ReDim myarr(1 To 9, 1 To 1)
ListBox1.RowSource = vbNullString
Set k = Range("A:A").Find("*" & TextBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        a = a + 1
        ReDim Preserve myarr(1 To 9, 1 To a)
        myarr(1, a) = k.Value
        myarr(2, a) = k.Offset(0, 1).Value
        myarr(3, a) = k.Offset(0, 2).Value
        myarr(4, a) = k.Offset(0, 3).Value
        myarr(5, a) = k.Offset(0, 4).Value
        myarr(6, a) = k.Offset(0, 5).Value
        myarr(7, a) = k.Offset(0, 6).Value
        myarr(8, a) = k.Offset(0, 7).Value
        myarr(9, a) = k.Offset(0, 8).Value
        Set k = Range("A:A").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    ListBox1.Column = myarr
End If
Erase myarr
Set k = Nothing
End Sub

 

[HD1975]

.......

Evren Bey , Teşekkür ederim.

Yalnız bu tip tek tip filtreleme örenkerini forumdan alıp yaptım.Yapamadığım şu

Textbox1 : Kişi no yazdımmı tüm satırları filtrelesin
Textbox2 : Adını yazdımmı tüm satırları filtrelesin.
Textbox3 : Not yazfığım zaman tüm satırları filtrelesin.
Textbox4 : Tarih yazdığım zaman filtrelrsin.

Verilerimde Sayfa5 De olacak.

Bunu halledemedim.

Saygılar

 

[kadir74]

Merhaba Sayın Orion1
Vermiş olduğunuz örnek dosyayı kendi uygulamama göre düzenledim.Uygulama çalışıyor yalnız
Benim tarih(Textbox) O sütünunda
Makine seçmek için de bir Combobox uyguladım.uygulama çalışıyor fakat tarih yada makine araması yaptığımda bana resimlerdeki gibi bir görüntü veriyor.Aynı durumu makine içinde yapıyor.İstediğim hangi tarihi veriyorsam yada hangi makine'yi seçiyorsam.A sutunundan T sutununa kadar görünmesi.Bir yerde bir yeri gözden kaçırıyorum.Ama bulamadım.Bu konuda yardımlarınızı rica edicektim.

Saygılarımla.

Tarih seçmek için----
Private Sub TextBox16_Change()
Dim myarr() As String, k As Range, adr As String, a As Long
ReDim myarr(1 To 18, 1 To 1)
ListBox1.RowSource = vbNullString
Set k = Range("O:O").Find("*" & TextBox16.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
o = o + 1
ReDim Preserve myarr(1 To 18, 1 To o)
myarr(1, o) = k.Value
myarr(2, o) = k.Offset(0, 1).Value
myarr(3, o) = k.Offset(0, 2).Value

Set k = Range("O:O").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
ListBox1.Column = myarr

End If
Erase myarr
Set k = Nothing
End Sub


Makine seçmek için----

Private Sub ComboBox6_Change()
Dim myarr() As String, k As Range, adr As String, a As Long
ReDim myarr(1 To 18, 1 To 1)
ListBox1.RowSource = vbNullString
Set k = Range("A:A").Find("*" & ComboBox6.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 18, 1 To a)
myarr(1, a) = k.Value
myarr(2, a) = k.Offset(0, 1).Value
myarr(3, a) = k.Offset(0, 2).Value
Set k = Range("A:A").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
ListBox1.Column = myarr
End If
Erase myarr
Set k = Nothing
End Sub

kodları kullandım

 

[kadir74]

Merhaba Orion1 Hocam,

Sıkıntının Tarih Bölümünden olduğunu farkettim.Tarih Yerine Üretim numarasını tahsis edince her iki bölümde istediğim verimi aldım.18 sütunum vardı

ReDim Preserve myarr(1 To 18, 1 To a)
myarr(1, a) = k.Value
myarr(2, a) = k.Offset(0, 1).Value
myarr(3, a) = k.Offset(0, 2).Value ------------ ksımı da 18 e çıkarınca herşey tamamlanmış oldu.

Tekrar Numune örneğiniz içinde Teşekkür ederim.

Saygılarımla