+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Birbirine Bağlı Listbox (/konu-birbirine-bagli-listbox.html)
Sayfalar:
1
2
Birbirine Bağlı Listbox - malatyalı - 26/04/2021
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
RE: Birbirine Bağlı Listbox - feraz - 27/04/2021
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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubRE: Birbirine Bağlı Listbox - malatyalı - 27/04/2021
Ustam cansın.
Teşekkür ederim
RE: Birbirine Bağlı Listbox - feraz - 27/04/2021
Rica ederim abey,bugün kodu kısaltırım öğleden sonra.
RE: Birbirine Bağlı Listbox - feraz - 27/04/2021
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 SubPrivate 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 SubRE: Birbirine Bağlı Listbox - malatyalı - 27/04/2021
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