• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Seçmeli ders

E

erdenek

Katılım
5 Mart 2008
Mesajlar
896
Excel Vers. ve Dili
EV:EXCEL 2010-TÜRKÇE
İŞ:EXCEL 2010-TÜRKÇE
arkadaşlar ekteki dosyada ders seçimi yapan öğrencilerin seçtikleri derslerin altında çarpı işareti seçmeyenlerin herhangi bir işaret yok.buradan hareketle dosyada ders seçimi yapmayan öğrencilerin listesini sınıf sınıf nasıl alabiliriz.yalnız bunu yaparken ders seçimi yapmamış olan öğrenci daha sonra gelip ders seçimi yaptığı zaman seçmeyenler listesinden silinmesi lazım.
 

Ekli dosyalar

arkadaşlar yok mu bunun bir çaresi
 
Özelden de sormuşsunuz ama bugün epey uğraştım, maalesef yapamadım.
 
Formülle hiç yapamazdım zaten. Uzun uğraşlar sonunda makroyla hallettim:

Kod: 
Sub seçmeyenler()
Set s1 = Sheets("Liste")
Set s2 = Sheets("şablon")
Dim Sh As String
For a = 4 To s1.Cells(Rows.Count, 2).End(xlUp).Row
Sh = s1.Cells(a, 2).Value
If Not SheetExist(Sh) Then
Sheets("Şablon").Copy After:=Sheets(1)
ActiveSheet.Name = Sh
End If
Set NewSh = Nothing
Next

For b = 4 To s1.Cells(Rows.Count, 2).End(xlUp).Row
s1.Select
If WorksheetFunction.CountIf(s1.Range(Cells(b, "e"), Cells(b, "az")), "X") = 0 Then
sınıf = s1.Cells(b, 2)
'Sheets(sınıf).Select
c = Sheets(sınıf).[c100].End(xlUp).Row + 1
Sheets(sınıf).Cells(c, 3) = s1.Cells(b, 2)
Sheets(sınıf).Cells(c, 4) = s1.Cells(b, 3)
Sheets(sınıf).Cells(c, 5) = s1.Cells(b, 4)
End If
Next
End Sub

Function SheetExist(ShName As String) As Boolean
On Error Resume Next
SheetExist = IIf(Sheets(ShName).Select, True, False)
End Function

Bu aktarma işlemini hallediyor. Biraz uzun sürüyor maalesef. Önce tüm sınıflar için ayrı sayfa oluşturuyor sonra liste sayfasında her satırı ayrı ayrı kontrol edip ders seçmeyenleri ilgili sayfalara aktarıyor. Ders seçince sayfadan silinsin işlemini şimdilik yapabileceğimi sanmıyorum.
 
Ders seçildiğinde silme işlemini de tam ideal olmasa da şu şekilde hallettim. Aşağıdaki kodları Liste sayfasının kod bölümüne yapıştırın:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
a = Cells(Rows.Count, 2).End(3).Row
If Intersect(Target, Range(Cells(4, "e"), Cells(a, "ag"))) Is Nothing Then Exit Sub
If Target = "X" Then
sınıf1 = Cells(Target.Row, "B")
öğrenci = Cells(Target.Row, "c")
Sheets(sınıf1).Select
Set c = Sheets(sınıf1).[d5:d50].Find(öğrenci)
If Not c Is Nothing Then
c.Select
ActiveCell.EntireRow.Delete
End If
End If
Sheets("Liste").Select
End Sub

Eski kodlarınızla çakışmadan çalışıyor. Ancak sağlıklı çalışması için öncelikle seçmeyen öğrencileri listeleme işlemini yapmalısınız. Çünkü daha önce sınıf listesi oluşturulmamış bir öğrenci için ders seçtiğinzide makro hata verecektir. Çünküo makroyu kaydettiğinizden itibaren ders seçme alanına her X ya da x girdiğinizde o öğrencinin sınıf listesini seçmek isteyecek, sınıf yoksa problem olacaktır.
 
hocam ben makro kaydetmeyi bilmiyorum.o dosyadaki makroları bir başka arkadaş hazırlamıştı.
 
Zor bir şey değil ayrıca öğrenmek için geç değil, ben de yeni öğrendim sayılır. 1 yıl öncesine kadar makro gerektiren sorulara "ben yapamam" şeklinde cevap veriyordum, şimdi elimden geldiğince çözmeye uğraşıyorum.

Sub seçmeyenler() isimli makroyu kopyalayın
Dosyanızda makro bölümüne geçin (Alt+F11 ya da sayfa ismine sağ tık/kod görüntüle)
Insert menüsünden module'yi seçin
Bu kodları çıkan sayfaya yapıştırın

Çalıştırmak için aynı liste sayfasına, diğer sayfalardaki Listeye git düğmesi gibi düğme ekleyin ve makro ata deyin ve seçmeyenler makrosunu seçin. Daha sonra bu düğmeye bastığınızda makro çalışacaktır

Seçen öğrencinin silinmesi için ise daha basit bir yol var. Yine Liste sayfasındayken Alt+F11 ya da sayfa sekmesine sağ tık yapıp kod görüntüle deyin
Burdaki kodları kopyalayıp kod sayfasına yapıştırın. Orda önceden olan kodlar var onları değiştirmeyin. O kodların altına ya da üstüne yapıştırın. Çalıştırmak için bir şey yapmanıza gerek yok, sayfada değişiklik yaptığınızda otomatik çalışacaktır.
 
YUSUF44' Alıntı:
Zor bir şey değil ayrıca öğrenmek için geç değil, ben de yeni öğrendim sayılır. 1 yıl öncesine kadar makro gerektiren sorulara "ben yapamam" şeklinde cevap veriyordum, şimdi elimden geldiğince çözmeye uğraşıyorum.

Sub seçmeyenler() isimli makroyu kopyalayın
Dosyanızda makro bölümüne geçin (Alt+F11 ya da sayfa ismine sağ tık/kod görüntüle)
Insert menüsünden module'yi seçin
Bu kodları çıkan sayfaya yapıştırın

Çalıştırmak için aynı liste sayfasına, diğer sayfalardaki Listeye git düğmesi gibi düğme ekleyin ve makro ata deyin ve seçmeyenler makrosunu seçin. Daha sonra bu düğmeye bastığınızda makro çalışacaktır

Seçen öğrencinin silinmesi için ise daha basit bir yol var. Yine Liste sayfasındayken Alt+F11 ya da sayfa sekmesine sağ tık yapıp kod görüntüle deyin
Burdaki kodları kopyalayıp kod sayfasına yapıştırın. Orda önceden olan kodlar var onları değiştirmeyin. O kodların altına ya da üstüne yapıştırın. Çalıştırmak için bir şey yapmanıza gerek yok, sayfada değişiklik yaptığınızda otomatik çalışacaktır.
Genişletmek için tıkla ...

hocam dedikleriniz aynen yaptım.ders seçen öğrenci silme işini de yapıyor fakat bu sefer dağıt makrosu çalışmadı.örneğin 5-a sınıfından arzu kaya ya ders seçimi yaptım seçmeyenler listesinden sildi fakat dağıt düğmesine tıkladığımda makro hata verdi.dosya ekte hocam.
 

Ekli dosyalar

Daha önce zaten dağıtmamış mıydınız? neden bir daha dağıtıyorsunuz?
 
sonradan ders seçimi yapan öğrencinin seçtiği ders listelerine aktarılması lazım.yoksa o dersi kimlerin seçtiğini nasıl buluruz?
 
Dağıt makrosunda şöyle bir işlem yapılıyor gördüğüm kadarıyla:

Önce tüm sayfa sayısı bulunuyor. Diyelim ki 30 olsun. 30. sayfadan geriye doğru sayılıyor. Ta ki 4'e kadar ve bu sayfalar siliniyor.

Benim makro çalışıtğında dikkat ettiyseniz 1. ve 3. sayfalar arasına sınıf listelerini ekledi. Dolayısıyla sayfa sayısı arttı. sizin makro ilk 3 sayfayı yani liste, şablon ve öğrenci sayfalarını silmiyordu. Araya sınıf listeleri girince ilk 3 sayfa liste ve iki sınıf listesi oldun.

sizin makro bunlar dışındaki sayfaları silince şablon ve öğrenci sayfaları da silinmiş olduğundan ve makronuz şablon sayfasını kopyalayıp yeni ders sayfaları oluşturduğundan, bu hata oluşuyor çünkü artık dosyanızda şablon diye bir sayfa bulunmuyor.

Sorunun çözümü için Dağıt makrosunu aşağıdakiyle değiştirin:
Kod: 
Sub DAĞIT()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set L = Sheets("Liste")
[AH1] = Sheets.Count
For mm = Sheets.Count To 1 Step -1
If WorksheetFunction.CountIf(L.[e3:ag3], Sheets(mm).Name) = 1 Then
Sheets(mm).Delete
End If
Next
ders = WorksheetFunction.CountA(Range("E3:EE3")) + 4
For i = 5 To ders

Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = L.Cells(3, i)
L.Cells(3, i).AutoFilter Field:=i, Criteria1:="X"
son = L.Cells(Rows.Count, 4).End(3).Row
L.Range(L.Cells(4, 2), L.Cells(son, 4)).Copy
Range("C5").PasteSpecial (xlPasteValues)
Range("D2") = L.Cells(3, i).Value
Range("A1").Select
L.Cells(3, i).AutoFilter
Next
End Sub

Bu makro öncelikle tüm sayfaların ismini tarar. Sayfa adı liste sayfasındaki derslerden biriyse o sayfayı siler. sonra da dağıtma işlemini yapar (ki bu kısmına karışmadım zaten sadece silme olayını ayarladım).

Ayrıa sizin kodlarınızda bir şey fark ettim: 2. satırda bulunan Application.ScreenUpdating = False ifadesi makronun daha düzgün çalışmasını sağlıyor. Bu nedenle benim seçmeyenler makrosunun ikinci satırına da bu satırı eklemeniz iyi olur. Yani sub satırından sonra bu satır olsun sonra aynen devam etsin.
 
değiştirdim.daha önce ders adına tıkladığımda o ders sayfasına gidiyordu.yine öğrenciye tıkladığımda öğrencinin seçtiği dersleri gösteriyordu ama şimdi hiçbirşey göstermiyor.onun dışında diğer işlemlerde bir sıkıntı yok.
 
Bende öyle bir sorun yok. Az önce kodları dosyaya kopyaladım ve her makroyu ayrı ayrı denedim. Düzgün çalışıyorlar.
 
ben Office 2013 kullanıyorum ondan olabilir ya da ben makroları yanlış yere kopyaladım.
 
Dosyayı inceleyiniz. Her kayıttan sonra Dağıt makrosunu çalıştırmalısınız.
 

Ekli dosyalar

Muhammet Okumuş' Alıntı:
Dosyayı inceleyiniz. Her kayıttan sonra Dağıt makrosunu çalıştırmalısınız.
Genişletmek için tıkla ...

Hocam 1 nolu mesajdaki dosyayı sizin yaptığınız çalışmaya uyarlamaya çalıştım ama makro hata verdi.hocam sizin yaptığınız çalışma liseler için ortaokulda seçmeli dersler farklı.
 
Muhammet hocam sizin yaptığınız çalışmayı bizim okul için uyarladım ama çizelgede yer alan hukuk ve adalet dersindeki sonraki dersler bizde yok.olmayan derslerin sütunlarını sildiğim zaman makro hata veriyor kaç gündür uğraştım ama bir türlü çözemedim.
 

Ekli dosyalar

Kodu aşağdaki kodla değiştiriniz.

Sub DAĞIT()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set L = Sheets("Liste")
For sil = Sheets.Count To 5 Step -1
Sheets(sil).Delete
Next
ders = WorksheetFunction.CountA(Range("E3:EE3")) + 4
For i = 5 To ders

Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = L.Cells(3, i)
Range("D2") = L.Cells(3, i).Value
If WorksheetFunction.CountA(L.Range(L.Cells(4, i), L.Cells(1000, i))) = 0 Then GoTo 10
L.Cells(3, i).AutoFilter Field:=i, Criteria1:="X"
son = L.Cells(Rows.Count, 4).End(3).Row
L.Range(L.Cells(4, 2), L.Cells(son, 4)).Copy
Range("C5").PasteSpecial (xlPasteValues)
Range("A1").Select
L.Cells(3, i).AutoFilter
10
Next
Sheets("Liste").Select
Sheets("Seçmeyenler").Range("C5:E1000") = ""
son = Cells(Rows.Count, 4).End(3).Row
Range("AW4:AW" & son) = "=COUNTA(E4:AV4)"
Cells(3, "AW") = "X"
Cells(3, "AW").AutoFilter Field:=1, Criteria1:=0
son = Cells(Rows.Count, 4).End(3).Row
Range(Cells(4, 2), Cells(son, 4)).Copy
Sheets("Seçmeyenler").Range("C5").PasteSpecial (xlPasteValues)
Cells(3, "AW").AutoFilter
Range("AW:AW") = ""
Set L = Nothing
End Sub
Genişletmek için tıkla ...
 
hocam ellerine sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst