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.

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