Skip to main content

AccessTr.neT


Birbirine Bağlı Listbox

Birbirine Bağlı Listbox

Çözüldü #1
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
.zip Kitap11.zip (Dosya Boyutu: 1,99 MB | İndirme Sayısı: 6)
malatyalı, 31-01-2010 tarihinden beri AccessTr.neT üyesidir.
Son Düzenleme: 26/04/2021, 15:36, Düzenleyen: malatyalı.
Cevapla
#2
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
.rar Kitap11.rar (Dosya Boyutu: 1,96 MB | İndirme Sayısı: 5)
Cevapla
#3
Ustam cansın.
Teşekkür ederim
malatyalı, 31-01-2010 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#4
Rica ederim abey,bugün kodu kısaltırım öğleden sonra.
Cevapla
#5
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
.rar Kitap11.rar (Dosya Boyutu: 1,96 MB | İndirme Sayısı: 3)
Cevapla
#6
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
malatyalı, 31-01-2010 tarihinden beri AccessTr.neT üyesidir.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task