Birbiri ile ilişkili üç Listbox

[omeryılmaz]

Saygıdeğer Hocalarım.
Yaptığım tüm çalışma ve araştırmalar sonucu aşağıda ve örnek dosyada açıkladığım gibi bir çalışmaya, yapacağınız destek ve önerileriniz için şimdiden şükranlarını sunuyorum....
A Sütununda İlçeler - B Sütununda Aile Sağlığı Merkezleri - C sütununda Dr. ismleri mevcut.....

Listbox1 de İlçe Seçildiğinde Listebox 2 de o ilçeye ait Aile Sağlığı Merkezlerinin listelenmesi gerekmekte ve seçilen Aile Sağlığı Merkezinde çalışan doktor ismi ListBox3 de gözükmeli..................

 

[Korhan Ayhan]

Selamlar,

Dosyanızı 2007 formatında eklediğiniz için UserForm bilgilerinize ulaşamadım. Bu sebeple benzer bir örnek dosya hazırladım. İncelermisiniz.

Gerekli olan nesneler;
1 adet UserForm
3 adet ListBox
1 adet CommandButton (Sayfa üzerine yerleştirin formu açmak için.)


Uygulanan kod;

(Sayfa1 kod penceresine uygulayınız.)

Option Explicit
 
Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

(UserForm nesnesine uygulayınız.)

Option Explicit
 
Private Sub ListBox1_Click()
    Dim X As Long, LİSTE As New Collection, VERİ As Range
 
    If ListBox1.ListIndex < 0 Then Exit Sub
 
    On Error Resume Next
 
    For X = 2 To Range("A65536").End(3).Row
        If Cells(X, "A") = ListBox1.Value Then
            LİSTE.Add Cells(X, "B"), CStr(Cells(X, "B"))
        End If
    Next
 
    ListBox2.Clear
    ListBox3.Clear
 
    For Each VERİ In LİSTE
        ListBox2.AddItem VERİ
    Next
End Sub
 
Private Sub ListBox2_Click()
    Dim X As Long, LİSTE As New Collection, VERİ As Range
 
    If ListBox2.ListIndex < 0 Then Exit Sub
 
    On Error Resume Next
 
    For X = 2 To Range("A65536").End(3).Row
        If Cells(X, "A") = ListBox1.Value And Cells(X, "B") = ListBox2.Value Then
            LİSTE.Add Cells(X, "C"), CStr(Cells(X, "C"))
        End If
    Next
 
    ListBox3.Clear
 
    For Each VERİ In LİSTE
        ListBox3.AddItem VERİ
    Next
End Sub
 
Private Sub UserForm_Initialize()
    Dim X As Long
 
    For X = 2 To Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(Range("A2:A" & X), Cells(X, "A")) = 1 Then
            ListBox1.AddItem Cells(X, "A")
        End If
    Next
End Sub

 

[omeryılmaz]

Teşekkürler Hocam.......


İsteğim Buydu... Eline sağlık Saygılar.......

 

[siyahyedili]

teşekkürler