AccessTr.neT

Tam Versiyon: Birbirine Bağlı Listbox
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2
Hayırlı günler, hayırlı Ramazanlar
bölgeler sayfasında
Listbox1'e İlleri
Listbox2' ye seçilen İl' e göre İlçeleri
Listbox3' e seçilen ilçeye göre okulları nasıl getirebilirim?

Textbox1 ile de listbox1 de süzme işlemini gerçekleştirebilir miyiz
saygı ve hürmetlerimle
Merhaba.Müsait olsunca kodları kısaltırım bir sub içine alıp.

[Resim: do.php?img=10962]

Private Sub ListBox1_Click()

    Dim dic As Object, veri, aranan As String
   
    Set dic = CreateObject("Scripting.dictionary")
    With Sayfa2
        veri = .Range("A2:C" & .Range("A" & Rows.Count).End(3).Row).Value
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 2)
            If veri(i, 1) = ListBox1.Value Then
                If Not dic.exists(aranan) Then If Not dic.exists(aranan) Then dic.Add aranan, ""
            End If
        Next
    End With
    With ListBox2
    .Clear
    ListBox3.Clear
    .List = dic.keys
    End With
    Set dic = Nothing: Erase veri
End Sub


Private Sub ListBox2_Click()
    Dim dic As Object, veri, aranan As String
    If ListBox1.ListIndex = -1 Then
   
        ListBox3.Clear
        Exit Sub
    End If
    Set dic = CreateObject("Scripting.dictionary")
    With Sayfa2
        veri = .Range("A2:C" & .Range("A" & Rows.Count).End(3).Row).Value
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 3)
            If veri(i, 1) & "|" & veri(i, 2) = ListBox1.Value & "|" & ListBox2.Value Then
                If Not dic.exists(aranan) Then If Not dic.exists(aranan) Then dic.Add aranan, ""
            End If
        Next
    End With
    With ListBox3
    .Clear
    .List = dic.keys
    End With
    Set dic = Nothing: Erase veri
End Sub

Private Sub TextBox1_Change()
    Dim dic As Object, veri, aranan As String
   
    Set dic = CreateObject("Scripting.dictionary")
    With Sayfa2
        veri = .Range("A2:A" & .Range("A" & Rows.Count).End(3).Row).Value
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 1)
'          If LCase(veri(i, 1)) Like "*" & LCase(TextBox1.Value) & "*" Then 'icerik arama
          If LCase(veri(i, 1)) Like LCase(TextBox1.Value) & "*" Then 'bastan arama
                If Not dic.exists(aranan) Then If Not dic.exists(aranan) Then dic.Add aranan, ""
          End If
        Next
    End With
    With ListBox1
    .Clear
    .List = dic.keys
    End With
    Set dic = Nothing: Erase veri
End Sub

Private Sub UserForm_Initialize()
    Dim dic As Object, veri, aranan As String
   
    Set dic = CreateObject("Scripting.dictionary")
    With Sayfa2
        veri = .Range("A2:C" & .Range("A" & Rows.Count).End(3).Row).Value
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 1)
            If Not dic.exists(aranan) Then If Not dic.exists(aranan) Then dic.Add aranan, ""
        Next
    End With
    With ListBox1
    .Clear
    .List = dic.keys
    End With
    Set dic = Nothing: Erase veri
    TextBox1.SetFocus
End Sub
Ustam cansın.
Teşekkür ederim
Rica ederim abey,bugün kodu kısaltırım öğleden sonra.
Bu dosyada kod kısaltılıp tek sub içine alındı abey.Bence bunu kullanın.


Sub lstboxlar(alan As Byte)
    Dim dic As Object, veri, aranan As String

    Set dic = CreateObject("Scripting.dictionary")
    With Sayfa2
        veri = .Range("A2:C" & .Range("A" & Rows.Count).End(3).Row).Value
    End With
       
    If alan = 1 Then 'userform acilis ve Listbox1 icin
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 1)
            If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
        Next
        With Me.ListBox1
            .Clear: If dic.Count > 0 Then .List = dic.keys: TextBox1.SetFocus
        End With
    ElseIf alan = 2 Then 'Listbox2 ye veri almak icin
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 2)
            If veri(i, 1) = ListBox1.Value Then _
                If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
        Next
        With Me.ListBox2
            .Clear: Me.ListBox3.Clear: If dic.Count > 0 Then .List = dic.keys
        End With
    ElseIf alan = 3 Then 'Listbox2 ye veri almak icin
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 3)
            If veri(i, 1) & "|" & veri(i, 2) = ListBox1.Value & "|" & ListBox2.Value Then
                If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
            End If
        Next
        With Me.ListBox3
            .Clear: If dic.Count > 0 Then .List = dic.keys
        End With
    ElseIf alan = 4 Then 'textbox arama icin
        For i = LBound(veri) To UBound(veri)
            aranan = veri(i, 1)
            If LCase(veri(i, 1)) Like "*" & LCase(TextBox1.Value) & "*" Then _
                If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
        Next
        With Me.ListBox1
            .Clear: If dic.Count > 0 Then .List = dic.keys
        End With
    End If

    Set dic = Nothing: Erase veri
End Sub

Private Sub UserForm_Initialize()
    Call lstboxlar(1)
End Sub
Private Sub ListBox1_Click()
    Call lstboxlar(2)
End Sub
Private Sub ListBox2_Click()
    Call lstboxlar(3)
End Sub
Private Sub TextBox1_Change()
    Call lstboxlar(4)
End Sub
Allah bu karşılıksız yardımınızı, sabrınızı, ilgi ve alakanızı boş çevirmesin inşallah.
Yaradan yar ve yardımcınız olsun.
Ellerinize sağlık. Teşekkür ederim. Var olasınız
Sayfalar: 1 2