Vba ile seçmeli listeleme

[baydeniro]

Merhaba Arkadaşlar,

Örnek dosya linki aşağıda bulunmaktadır. Soru şu şekildedir :

1. Sayfa "ÖĞRENCİLER" : B sütununda öğrenci isimleri, C sütununda Spor veya Müzik seçmeli dersleri bulunuyor

2. Sayfa "SPOR" : ÖĞRENCİLER sayfası C sütununda hangi öğrencinin adının yanında SPOR yazılırsa bu sayfaya kaydedilebilecek ve VERİ DOĞRULAMA ile oluşturulacak öğrenci listesinde o öğrenciler bulunacaktır.

3. Sayfa "MÜZİK" : ÖĞRENCİLER sayfası C sütununda hangi öğrencinin adının yanında MÜZİK yazılırsa bu sayfaya kaydedilebilecek ve VERİ DOĞRULAMA ile oluşturulacak öğrenci listesinde o öğrenciler bulunacaktır.

Sayfaların adlarına göre öğrencilerin listelenmesinin VBA ile yapılabilmesi mümkün mü ?

http://s5.dosya.tc/server3/8re774/SECMELI_LISTELEME.xls.html

 

[Ömer BARAN]

Merhaba.

Alt taraftan ÖĞRENCİLER sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
Açılan VBA ekranında, sağ taraftaki boş alana aşağıdaki kod'u yapıştırın.
C sütunundaki değerlerde SPOR/MÜZİK tercihlerini yapıp SPOR veya MÜZİK sayfasına geçtiğinizde
veri doğrulama listelerinin güncellendiğini göreceksiniz.
.

[FONT="Arial Narrow"][COLOR="Blue"]Private Sub Worksheet_Deactivate()[/COLOR]
    Call VERİ_DOĞRULAMA
[COLOR="blue"]End Sub[/COLOR]

[B]Sub VERİ_DOĞRULAMA()[/B]
With Sheets("SPOR").[B2:B10].Validation
    .Delete
For satır = 2 To Sheets("ÖĞRENCİLER").[B65536].End(3).Row
    If Sheets("ÖĞRENCİLER").Cells(satır, 3) = "SPOR" Then SPOR = SPOR & "," & Sheets("ÖĞRENCİLER").Cells(satır, 2)
Next: sporcu = Mid(SPOR, 2, Len(SPOR) - 1)
    .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=sporcu: .InCellDropdown = True
End With
With Sheets("MÜZİK").[B2:B10].Validation
    .Delete
For satır = 2 To Sheets("ÖĞRENCİLER").[B65536].End(3).Row
    If Sheets("ÖĞRENCİLER").Cells(satır, 3) = "MÜZİK" Then müzik = müzik & "," & Sheets("ÖĞRENCİLER").Cells(satır, 2)
Next: müzikci = Mid(müzik, 2, Len(müzik) - 1)
    .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=müzikci: .InCellDropdown = True
End With
[B]End Sub[/B][/FONT]

 

[baydeniro]

Ömer BARAN üstadım şapka çıkardım vesselam. Mükemmel bir şey olmuş. Ben yapılamaz muhtemelen diye düşünüyordum. Zira oldukça komplike bir durum. Sağlıcakla kalın.