• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

ListBox ta filtreleme

  • Konbuyu başlatan Konbuyu başlatan mbattal
  • Başlangıç tarihi Başlangıç tarihi
M

mbattal

Katılım
27 Aralık 2005
Mesajlar
213
Excel Vers. ve Dili
OFFICE-2003 Türkçe
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
 

Ekli dosyalar

Dosyanız ekte.:cool:
Kod: 
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
 

Ekli dosyalar

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
 
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..
 
Hepsini içerir şeklinde armak için ilgili kodu aşağıdaki ile değiştiriniz.:cool:
Kod: 
Set k = Range("A:A").Find([B][COLOR="Red"]"*" &[/COLOR][/B] TextBox1.Text & "*", , xlValues, xlWhole)
 
kamiloğlu' Alıntı:
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..
Genişletmek için tıkla ...
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.:cool:
Kod: 
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
 
maşallah bu ne hız böyle.. anında cevap.. lütfen dosyanızıda ekleyebilirmisiniz...
 
Merhaba

Evren Gizlen' Alıntı:
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.:cool:
Kod: 
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
Genişletmek için tıkla ...

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
 
Hangi sütunda sorgulama yapacaksınız?:cool:
 
Merhaba

Evren Gizlen' Alıntı:
Hangi sütunda sorgulama yapacaksınız?:cool:
Genişletmek için tıkla ...

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
 
Tamamda kişi noya göremi ada göremi arma yapacaksınız.:cool:
 
HD1975' Alıntı:
Kişi No'ya göre arama yapacağız.:biggrin:
Genişletmek için tıkla ...
Kodları düzenledim.Aşağıdaki kodları kullanabilirsiniz.:cool:
Kod: 
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
 
.......

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
 
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
 

Ekli dosyalar

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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst