[Yardım]  listbox ara süz

Verilerinizi listeleyebileceğiniz liste kutusu

listbox ara süz

İleti#1)  suludag » 09 Şub 2019 11:48

Selamünaleyküm, kolay gelsin.
Textboxa girilen değeri Listbox ta filtre işlemini forumdan bulduğum kodlarla yapmaya çalıştım fakat;
Listboxta listelenen sonuçlara tıklayınca en fazla 10 değeri textbox'a aktarıyor, çözümünü bulamadım
Yardımcı olur musunuz

Teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
suludag
Yeni Başlamış
 
Adı Soyadı:serkan uludağ
Kayıt: 02 Ağu 2009 23:41
Yaş: 36
İleti: 13
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

Cevap: listbox ara süz

İleti#2)  Ali ÖZ » 09 Şub 2019 12:07

Merhaba,
Form kodlarını bu şekilde değiştirin.

Kod: Tümünü seç
Private Sub ListBox1_Click()
    TextBox1.Text = ListBox1.Column(0)
    TextBox2.Text = ListBox1.Column(1)
    TextBox3.Text = ListBox1.Column(2)
    TextBox4.Text = ListBox1.Column(3)
    TextBox5.Text = ListBox1.Column(4)
    TextBox6.Text = ListBox1.Column(5)
    TextBox7.Text = ListBox1.Column(6)
    TextBox8.Text = ListBox1.Column(7)
    TextBox9.Text = ListBox1.Column(8)
    TextBox10.Text = ListBox1.Column(9)
    TextBox11.Text = ListBox1.Column(10)
    TextBox12.Text = ListBox1.Column(11)
    TextBox13.Text = ListBox1.Column(12)
    TextBox14.Text = ListBox1.Column(13)

End Sub

Private Sub TextBox15_Change()
    Dim sutun As String
    If OptionButton1.Value = True Then
        sutun = "no"
    ElseIf OptionButton2.Value = True Then
        sutun = "adı"
    ElseIf OptionButton3.Value = True Then
        sutun = "soyadı"

    End If

ListBox1.Clear
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;" & "data source=" & ThisWorkbook.FullName & ";" & _
"extended properties=""excel 12.0;hdr=yes"""
sorgu = "select * from [personel listesi$] where [" & sutun & "] like '" & TextBox15.Text & "%'"
rs.Open sorgu, con, 1, 1
With ListBox1
    If .ListCount < 1 Then
    .ColumnCount = rs.Fields.Count
    .ColumnWidths = "60;60"
    .Column = rs.getrows
    End If
End With
End Sub

Private Sub UserForm_Initialize()
On Local Error Resume Next
OptionButton2.Value = True
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;" & "data source=" & ThisWorkbook.FullName & ";" & _
"extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * from [personel listesi$]", con, 1, 1
With ListBox1
    If .ListCount < 1 Then
    .ColumnCount = rs.Fields.Count
    .ColumnWidths = "60;60"
    .Column = rs.getrows
    End If
End With
End Sub
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 9814
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: listbox ara süz

İleti#3)  askmadige34 » 09 Şub 2019 12:15

Aşağıdaki kodları deneyin.
Kod: Tümünü seç
Private Sub TextBox15_Change()
Dim askm()
Dim son As Long
son = Range("B" & Rows.Count).End(3).Row

Dim sat As Long
    Dim s As Long
    Dim sutun As Byte
    If OptionButton1.Value = True Then
        sutun = 1
    ElseIf OptionButton2.Value = True Then
        sutun = 2
    ElseIf OptionButton3.Value = True Then
        sutun = 3

    End If
    s = 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ListBox1.RowSource = Empty
ListBox1.Clear
j = 0
For sat = 2 To son
    If LCase(Sheets("personel listesi").Cells(sat, sutun)) Like LCase("*" & TextBox15.Value & "*") Then
        ReDim Preserve askm(0 To 14, 0 To j)
        askm(0, j) = Cells(sat, 1)
        askm(1, j) = Cells(sat, 2)
        askm(2, j) = Cells(sat, 3)
        askm(3, j) = Cells(sat, 4)
        askm(4, j) = Cells(sat, 5)
        askm(5, j) = Cells(sat, 6)
        askm(6, j) = Cells(sat, 7)
        askm(7, j) = Cells(sat, 8)
        askm(8, j) = Cells(sat, 9)
        askm(9, j) = Cells(sat, 10)
        askm(10, j) = Cells(sat, 11)
        askm(11, j) = Cells(sat, 12)
        askm(12, j) = Cells(sat, 13)
        askm(13, j) = Cells(sat, 14)
        j = j + 1
    End If
Next sat
    If j > 0 Then
        ListBox1.Column = askm
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Private Sub UserForm_Initialize()

OptionButton2.Value = True

With Sheets("personel listesi")
    ListBox1.Clear
'    ListBox1.ColumnHeads = True
    ListBox1.ColumnCount = 14
    ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50;50;50;50"
    ListBox1.RowSource = "A2:ZZ1000"
End With

End Sub
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 11:04
Meslek: memur
Yaş: 39
İleti: 1720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: listbox ara süz

İleti#4)  suludag » 09 Şub 2019 14:10

Sn.Ali Öz ve Sn.askmadige34 yardımlarınız için çok teşekkür ederim, tam istediğim şekilde olmuş
Süzme işlemi yapınca Listbox başlıkları kayboluyor. Bu konuda da yardımcı olabilir misiniz.

Teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
suludag
Yeni Başlamış
 
Adı Soyadı:serkan uludağ
Kayıt: 02 Ağu 2009 23:41
Yaş: 36
İleti: 13
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: listbox ara süz

İleti#5)  askmadige34 » 09 Şub 2019 16:51

Dizi ile başlık ekleme işleminde genellikle label kullanılır. Ama alternatif bir çözüm olarak aşağıdaki kodları kullanabilirsiniz.
Kod: Tümünü seç
Private Sub ListBox1_Click()
    If ListBox1.Selected(0) = True Then Exit Sub
    TextBox1.Text = ListBox1.Column(0)
    TextBox2.Text = ListBox1.Column(1)
    TextBox3.Text = ListBox1.Column(2)
    TextBox4.Text = ListBox1.Column(3)
    TextBox5.Text = ListBox1.Column(4)
    TextBox6.Text = ListBox1.Column(5)
    TextBox7.Text = ListBox1.Column(6)
    TextBox8.Text = ListBox1.Column(7)
    TextBox9.Text = ListBox1.Column(8)
    TextBox10.Text = ListBox1.Column(9)
    TextBox11.Text = ListBox1.Column(10)
    TextBox12.Text = ListBox1.Column(11)
    TextBox13.Text = ListBox1.Column(12)
    TextBox14.Text = ListBox1.Column(13)
End Sub

Private Sub TextBox15_Change()
Dim askm()
Dim son As Long
son = Range("B" & Rows.Count).End(3).Row

Dim sat As Long
    Dim s As Long
    Dim sutun As Byte
    If OptionButton1.Value = True Then
        sutun = 1
    ElseIf OptionButton2.Value = True Then
        sutun = 2
    ElseIf OptionButton3.Value = True Then
        sutun = 3

    End If
    s = 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ListBox1.RowSource = Empty
ListBox1.Clear
j = 0
For sat = 1 To son
    If LCase(Sheets("personel listesi").Cells(sat, sutun)) Like LCase("*" & TextBox15.Value & "*") Or sat = 1 Then
        ReDim Preserve askm(0 To 14, 0 To j)
        askm(0, j) = Cells(sat, 1)
        askm(1, j) = Cells(sat, 2)
        askm(2, j) = Cells(sat, 3)
        askm(3, j) = Cells(sat, 4)
        askm(4, j) = Cells(sat, 5)
        askm(5, j) = Cells(sat, 6)
        askm(6, j) = Cells(sat, 7)
        askm(7, j) = Cells(sat, 8)
        askm(8, j) = Cells(sat, 9)
        askm(9, j) = Cells(sat, 10)
        askm(10, j) = Cells(sat, 11)
        askm(11, j) = Cells(sat, 12)
        askm(12, j) = Cells(sat, 13)
        askm(13, j) = Cells(sat, 14)
        j = j + 1
    End If
Next sat
    If j > 0 Then
        ListBox1.Clear
        ListBox1.ColumnHeads = False
        ListBox1.ColumnCount = 14
        ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50;50;50;50"
'        ListBox1.RowSource = "A2:ZZ1000"
        ListBox1.Column = askm
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Private Sub UserForm_Initialize()

OptionButton2.Value = True

With Sheets("personel listesi")
    ListBox1.Clear
    ListBox1.ColumnHeads = True
    ListBox1.ColumnCount = 14
    ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50;50;50;50"
    ListBox1.RowSource = "A2:ZZ1000"
End With

End Sub
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 11:04
Meslek: memur
Yaş: 39
İleti: 1720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: listbox ara süz

İleti#6)  suludag » 10 Şub 2019 09:05

sn askmadige34 teşekkür ederim, verdiğiniz kodla hallettim.

iyi çalışmalar dilerim.
Kullanıcı avatarı
suludag
Yeni Başlamış
 
Adı Soyadı:serkan uludağ
Kayıt: 02 Ağu 2009 23:41
Yaş: 36
İleti: 13
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: listbox ara süz

İleti#7)  feraz » 11 Şub 2019 00:31

Merhaba.

askmadige34 hocamızın kodunu Ali Öz hocamızın Ado koduna göre yaptım.
Deneyebilirsiniz.


Kod: Tümünü seç
Const sutunGenslk As String = "60;60;60;60;60;60;60;60;60;60;60;60;60;60"
Const sayfaAd As String = "personel listesi"
Const sayfaAdAdo As String = sayfaAd & "$"
'Const baslk As String = "A1:N1"

Const sutunSay As Integer = 14

Dim LstboxAd As MSForms.ListBox


Sub LstboxAddd()
   Set LstboxAd = Me.ListBox1
End Sub



Private Sub ListBox1_Click()

With LstboxAd
    TextBox1.Text = .Column(0)
    TextBox2.Text = .Column(1)
    TextBox3.Text = .Column(2)
    TextBox4.Text = .Column(3)
    TextBox5.Text = .Column(4)
    TextBox6.Text = .Column(5)
    TextBox7.Text = .Column(6)
    TextBox8.Text = .Column(7)
    TextBox9.Text = .Column(8)
    TextBox10.Text = .Column(9)
    TextBox11.Text = .Column(10)
    TextBox12.Text = .Column(11)
    TextBox13.Text = .Column(12)
    TextBox14.Text = .Column(13)
End With
End Sub

Function suzz(sorguu As String)
    Dim i As Integer
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;" & "data source=" & ThisWorkbook.FullName & ";" & _
    "extended properties=""excel 12.0;hdr=yes"""
   
    rs.Open sorguu, con, 1, 1
    With LstboxAd
        .RowSource = ""
     If rs.RecordCount < 1 Then GoTo hata
     
          If rs.RecordCount > 0 Then
              If Not rs.EOF Then
                        .ColumnCount = rs.Fields.Count
                        .ColumnWidths = sutunGenslk
                        .Column = rs.GetRows
                        .AddItem , 0
                        .ColumnHeads = False
                        For i = 0 To rs.Fields.Count - 1
                            .List(0, i) = rs.Fields(i).name
                        Next
                       
                        .ListIndex = 0 'Listbox ilk satir secilir
                End If
         End If
         GoTo son
hata:
        .ColumnHeads = False
        .RowSource = ""
        .Clear
'        .RowSource = baslk
       
    End With
   
son:
    rs.Close: con.Close: Set rs = Nothing: Set con = Nothing

End Function



Private Sub TextBox15_Change()
    Dim sutun As String
    If OptionButton1.Value = True Then
        sutun = "no"
    ElseIf OptionButton2.Value = True Then
        sutun = "adı"
    ElseIf OptionButton3.Value = True Then
        sutun = "soyadı"
    End If
suzz ("select * from [" & sayfaAdAdo & "] where [" & sutun & "] like '%" & TextBox15.Text & "%'")


End Sub

Private Sub UserForm_Initialize()
OptionButton2.Value = True
Call LstboxAddd
With LstboxAd
    .RowSource = ""
    .ColumnHeads = True
    .ColumnCount = sutunSay
    .ColumnWidths = sutunGenslk
    .RowSource = Sheets(sayfaAd).Range("A2:N" & Sheets(sayfaAd).Cells(Rows.Count, 1).End(3).Row).Address
End With

End Sub

Private Sub UserForm_Terminate()
     Set LstboxAd = Nothing
     Set rs = Nothing: Set con = Nothing

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5952
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: listbox ara süz

İleti#8)  askmadige34 » 11 Şub 2019 19:32

Zafer bey ilk satırı eklememiş. Onu ekleyeyim. If ListBox1.Selected(0) = True Then Exit Sub satırı ile ilk satır yani başlıklar seçili ise textboxlara veri aktarmaz. Daha hoş bir görüntü olur bence.
Kod: Tümünü seç
Private Sub ListBox1_Click()
If ListBox1.Selected(0) = True Then Exit Sub
With LstboxAd
    TextBox1.Text = .Column(0)
    TextBox2.Text = .Column(1)
    TextBox3.Text = .Column(2)
    TextBox4.Text = .Column(3)
    TextBox5.Text = .Column(4)
    TextBox6.Text = .Column(5)
    TextBox7.Text = .Column(6)
    TextBox8.Text = .Column(7)
    TextBox9.Text = .Column(8)
    TextBox10.Text = .Column(9)
    TextBox11.Text = .Column(10)
    TextBox12.Text = .Column(11)
    TextBox13.Text = .Column(12)
    TextBox14.Text = .Column(13)
End With
End Sub


Textbox kodlarını da aşağıdaki gibi son satırı eklerseniz de yazdığınız harfe ya da rakama göre ilk satırı seçmeden 2. satırı seçtirir.

Kod: Tümünü seç
Private Sub TextBox15_Change()
    Dim sutun As String
    If OptionButton1.Value = True Then
        sutun = "no"
    ElseIf OptionButton2.Value = True Then
        sutun = "adı"
    ElseIf OptionButton3.Value = True Then
        sutun = "soyadı"
    End If
suzz ("select * from [" & sayfaAdAdo & "] where [" & sutun & "] like '%" & TextBox15.Text & "%'")

On error resume next
ListBox1.Selected(1) = True

End Sub
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 11:04
Meslek: memur
Yaş: 39
İleti: 1720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: listbox ara süz

İleti#9)  feraz » 11 Şub 2019 19:36

Eklediğiniz için sağolun Ali hocam.

Ben Textboxlara aktarma olayına bakmamıştım.
Tabii başlıklar eklenince dediğiniz gibi olmalı :)
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5952
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray


Forum ListBox

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe