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]](https://resim.accesstr.net/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