listboxda filtre uygulaması

Barons · 30 Ocak 2009

merhaba
Bir kaç gündür listboxda filtre konusunu araştırıyorum.yabancı sitelerden birinde yazılı bir dökümanı ekli dosyaya uyguladım.Burada uygulamak istediğim ise "H" sütunundaki personel isimlerine göre filtre etmek.Textbox1 kutusuna personel ismi girince listbox bu verileri getirmeli.Bir türlü başaramadım.

yardımcı olursanız çok sevinirim.

Not: Forumdaki araştırmalarıma göre böyle bir uygulamanın bir çok arkadaşın işine yarayacağını düşünüyorum.

selamlar-saygılar

metinozlu · 31 Ocak 2009

Çözüm ektedir.

metinozlu · 31 Ocak 2009

kodlar aşağıdali şekilde değiştirildi
vList = Range("h2", Cells(Rows.Count, 8).End(xlUp)).Value 'bu kod değişti

Barons · 31 Ocak 2009

Sn.Metinozlu
yardımınız için çok teşekkürler...Ancak ben listboxda tüm veritabanının gözükmesini,yani sayfa1' deki tablonun A2:L arasını listbox'da göstermesini ve textbox'a H sütunundaki personel adının girilince H sütununa göre filtre yapmasını ve diğer sütunlarla birlikte göstermesini istiyordum.Sanırım yanlış anlattım.Tekrar yardımcı olursanız minnettar kalacağım.
Ek olarak listbox bu veriyi alırken arkada sayfa1 gözükmese bu mümkünmüdür.Yani sadece userform gözükse?

Tekrar çok çok Teşekkürler

Orion1 · 31 Ocak 2009

Dosyanız ektedir.

Kod:

Private Sub TextBox1_Change()
Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 12, 1 To 1)
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    'Show all records of Database on Sheet1
    If .FilterMode Then .ShowAllData
    Set k = .Range("H2:H65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 12, 1 To a)
            For j = 1 To 12
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("H2:H65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With
End Sub

Barons · 31 Ocak 2009

Sn.Evren Gizlen
Müthiş...çok teşekkürler...Tam istediğim gibi olmuş
Bu listbox'dan herkesin yararlanması dileğiyle
Allah işlerinizi rast getirsin,kolaylaştırsın...(MetinOzlu kardeşimede ayrıca teşekkürler)

Orion1 · 31 Ocak 2009

Barons' Alıntı:
Sn.Evren Gizlen
Müthiş...çok teşekkürler...Tam istediğim gibi olmuş
Bu listbox'dan herkesin yararlanması dileğiyle
Allah işlerinizi rast getirsin,kolaylaştırsın...(MetinOzlu kardeşimede ayrıca teşekkürler)

Rica ederim.
İyi çalışmalar.

Barons · 31 Ocak 2009

son bir şey daha var...zahmet olacak ama aklıma gelmişken onuda sormak istiyorum.
userform direk kişi adı ile mesela "Ali Duman" filtre edilmiş şekliyle açılabilirmi? Ben userformun
initialize olayına textbox1.value="Ali Duman" diye yazdım ancak olmadı.

Orion1 · 31 Ocak 2009

Initialize olayına aşağıdaki kodları yapıştırın,öncekileri silin.

Kod:

With Worksheets("Sayfa1")
If .FilterMode Then .ShowAllData
TextBox1.Text = "Ali Duman"
'Me.ListBox1.List = Range("A2:L" & .Cells(65536, "A").End(xlUp).Row).Value
Me.TextBox1.SetFocus
End With

Barons · 31 Ocak 2009

Bu ne hız ya..maşallah ...çok teşekkürler...tam istenilen hasıl olmuştur..Elinize sağlık

Barons · 31 Ocak 2009

Sn.Evren
Bu uygulamayı benim yapmak istediğim programa uyguladım..hata vermedi ancak benim yaptığım listbox uygulamasında ilk sütunu aldırmamıştım,direk tarihten başlıyor....sizin gönderdiğiniz uygulamada ilk satırı aldırmadan yapmaya çalıştım ama karıştırdım sanıyorum.Bu konuda yardımınız olabilirmi acaba?Yani listboz userformda açıldığında ilk sütun tarihten başlasın..s.No lar olmasın...Teşekkürler (sizede bu tatil günü zahmet veriyorum)

Barons · 31 Ocak 2009

listboxda ilk satır olan S.No çıkmasın istiyorum yani direk Tarih 'den başlasın (benim listbox'a uyguladığımda kayma olduda) ama başaramadım..birazda karıştırdım galiba...tatil günü sizede zahmet verdik.

Orion1 · 31 Ocak 2009

Textbox'ın içindeki kodları silin,aşağıdaki kodları yapıştırın.

Kod:

Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 11, 1 To 1)
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    'Show all records of Database on Sheet1
    If .FilterMode Then .ShowAllData
    Set k = .Range("H2:H65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 11, 1 To a)
            For j = 1 To 11
                myarr(j, a) = .Cells(k.Row, j + 1).Value
            Next j
            Set k = Range("H2:H65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With

Barons · 31 Ocak 2009

Sn.Evren çok teşekkürler
Şimdi oldu...çok özür ama bir durum daha var.eğer bunuda halledersem iş tamam olacak...şimdi ; listboxda sil-değiştir-ekle butonlarıda var.Listbox açılınca sizin gönderdiğiniz kodlarla (bu arada kodu ben textbox değilde combobox olarak değiştirdim..sorunsuz çalışıyor) listboxda sadece comboboxda tercih edilen personel çıkıyor.Buraya kadar işlem tamam ancak listbox çift tıklayıp içindeki verileri textboxlara alıyor ve değiştirme yapıp kaydet dediğimde değişikliği yapıyor ama bu sefer tüm datalar listbox'a geliyor.oysa yine sadece o personel olmalı.Buradaki amaç bir personel diğerinin verilerini görmemeli.
İnşallah anlatabilmişimdir.

Değiştir butonuna bağlı kod aşağıdadır?

Private Sub CommandButton2_Click()
'Değiştir butonuna basıldığında yapılacak işlemler.
sor = MsgBox("Değiştirmek istediğinizden eminmisiniz?", vbYesNo)
'mesaj kutusu devreye giriyor.
If sor = vbNo Then Exit Sub
'evet veya hayır cevaplarından Hayır ise kodlar sonlandırılıyor.
sonsat = ListBox1.ListIndex + 2
'son satır numarası alınıyor.
Cells(sonsat, 2) = TextBox1
'ikinci sutununun en son satırına textbox2 deki açıklama yazılıyor.

Cells(sonsat, 3) = TextBox2
Cells(sonsat, 4) = TextBox3
Cells(sonsat, 5) = TextBox4
Cells(sonsat, 6) = TextBox5
Cells(sonsat, 7) = TextBox6
Cells(sonsat, 8) = TextBox7
Cells(sonsat, 9) = TextBox8
'Cells(sonsat, 9) = CLng(CDate(TextBox8))
ListBox1.RowSource = "B2:L" & [a65536].End(3).Row
'liste kutusunun satır kaynagının hangi hücreler olduğu belirtiliyor.
MsgBox "DEĞİŞİKLİK YAPILMIŞTIR"
End Sub

Orion1 · 31 Ocak 2009

Bu şekilde değiştiriseniz arama bulmada ,hatalı satırı değiştirirsiniz.O zaman listboxa dizi ile verielri alırken dizinin içine verinin satır numarasınıda alıp bir sütunda listelemek lazım.Değişiklik yapacağınız zaman o stır numarası ile değiştirin.

Orion1 · 31 Ocak 2009

Kodları bu dosyadaki ne göre değiştiriniz.

Kod:

Private Sub TextBox1_Change()
Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 12, 1 To 1)
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    'Show all records of Database on Sheet1
    If .FilterMode Then .ShowAllData
    Set k = .Range("H2:H65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To [B][COLOR="Red"]11[/COLOR][/B], 1 To a)
            For j = 1 To [B][COLOR="red"]12[/COLOR][/B]
                myarr(j, a) = .Cells(k.Row, j + 1).Value
            Next j
            [B][COLOR="red"]myarr(12, a) = k.Row[/COLOR][/B] 
           Set k = Range("H2:H65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With
End Sub

Private Sub CommandButton2_Click()
If ListBox1.ListIndex < 0 Then Exit Sub
With Sheets("Sayfa1")
    .Cells(ListBox1.Column(11), "H").Value = TextBox2.Text
End With
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.ListIndex < 0 Then Exit Sub
With Sheets("Sayfa1")
    TextBox2.Text = ListBox1.Column(5)
End With
End Sub

Barons · 31 Ocak 2009

tekrar merhaba
sizin özel mail adresiniz varmı? oraya göndersem uygun olurmu acaba?

BirTürk1 · 7 Şubat 2009

Bi başlık satırı olsa iyi olmazmı.

murat23351 · 13 Mart 2010

selam arkadaşım bende buna benzer bir şeyler yapmaya çalışıyordum olmadı.. ama benim filtreleme 2 tane olacak yani birinci okul adına göre sonrada kadro tipine göre süzme yapıp kalan verileride sayfa2 de ilgili yere yazdırılmasını bir türlü yapamadım...

Orion1 · 13 Mart 2010

murat23351' Alıntı:
selam arkadaşım bende buna benzer bir şeyler yapmaya çalışıyordum olmadı.. ama benim filtreleme 2 tane olacak yani birinci okul adına göre sonrada kadro tipine göre süzme yapıp kalan verileride sayfa2 de ilgili yere yazdırılmasını bir türlü yapamadım...

Dosyanız ektedir.

Kod:

Private Sub ComboBox1_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, sat As Long
ReDim myarr(1 To 12, 1 To 1)
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("E9").Value = ""
Sheets("Sayfa2").Range("A18:C65536").ClearContents
sat = 19
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    Set k = .Range("b2:b65536").Find(ComboBox1.Value & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            If k.Offset(0, 1).Value Like ComboBox2.Value & "*" Then
                a = a + 1
                Sheets("Sayfa2").Range("E9").Value = k.Value
                Sheets("Sayfa2").Cells(sat, "A").Value = k.Offset(0, -1).Value
                Sheets("Sayfa2").Cells(sat, "B").Value = k.Offset(0, 2).Value
                Sheets("Sayfa2").Cells(sat, "C").Value = k.Offset(0, 3).Value
                sat = sat + 1
                ReDim Preserve myarr(1 To 12, 1 To a)
                For j = 1 To 12
                    myarr(j, a) = .Cells(k.Row, j).Value
                Next j
            End If
            Set k = Range("b2:b65536").FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adrs
            ListBox1.Column = myarr
        End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub ComboBox2_Change()
Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 12, 1 To 1)
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("E9").Value = ""
Sheets("Sayfa2").Range("A18:C65536").ClearContents
sat = 19
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    Set k = .Range("C2:C65536").Find(ComboBox2.Value & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            If k.Offset(0, -1).Value Like ComboBox1.Value & "*" Then
                a = a + 1
                Sheets("Sayfa2").Range("E9").Value = k.Offset(0, -1).Value
                Sheets("Sayfa2").Cells(sat, "A").Value = k.Offset(0, -2).Value
                Sheets("Sayfa2").Cells(sat, "B").Value = k.Offset(0, 1).Value
                Sheets("Sayfa2").Cells(sat, "C").Value = k.Offset(0, 2).Value
                sat = sat + 1
                ReDim Preserve myarr(1 To 12, 1 To a)
                For j = 1 To 12
                    myarr(j, a) = .Cells(k.Row, j).Value
                Next j
            End If
            Set k = Range("c2:c65536").FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adrs
            ListBox1.Column = myarr
        End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub


Private Sub CommandButton2_Click()

End Sub

Private Sub UserForm_Initialize()
Dim i As Long, sat As Long
With Worksheets("Sayfa1")
Me.ListBox1.List = .Range("A2:L" & .Cells(65536, "A").End(xlUp).Row).Value
End With
sat = Sheets("DB").Cells(65536, "A").End(xlUp).Row
ComboBox1.RowSource = "DB!A2:A" & sat
ComboBox2.AddItem "KADROLU"
ComboBox2.AddItem "SÖZLEŞMELİ"
End Sub

listboxda filtre uygulaması

Barons

Ekli dosyalar

metinozlu

Ekli dosyalar

metinozlu

Barons

Orion1

Uzman

Ekli dosyalar

Barons

Orion1

Uzman

Barons

Orion1

Uzman

Barons

Barons

Barons

Orion1

Uzman

Barons

Orion1

Uzman

Orion1

Uzman

Ekli dosyalar

Barons

BirTürk1

Destek Ekibi

Ekli dosyalar

murat23351

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar