sınıf listeleri

[ariza7]

Merhaba arkadaşlar, ben toplam 300 öğrenciden 8 sınıf oluşturmak istiyorum. ancak bu 300 öğrenci şu an alfabetik sıraya göre düzenlenmiş durumda. bunların karışık olarak sınıflara dağıtılması lazım. üstelik üç sütun var şu an. ilk sütunda okul noları, ikinci sütunda ad, üçüncü sütunda soyad bilgileri var. ada göre alfabetik sıraya koydum. ama karışık olarak 8 sınıf nasıl oluşturabilirim?

1 saattir forumda arıyorum ama bulamadım. pazartesiye listeleri yetiştirmem lazım. yardımcı olursanız sevinirim. bu arada konu yanlış yerdeyse özür dilerim.

ofis 2007 kullanıyorum. saygılar...

 

[Necdet]

Merhaba,

Örnek dosya ekleseydiniz konuya ilgi duyan arkadaşlar ayrıca dosya hazırlamak zorunda kalmazlardı.

 

[ariza7]

ilginize çok teşekkür ederim. ben öğrencilerin adlarını nette paylaşamayacağımdan dosya ekleyemedim. ama ayrıntılı olarak anlattım: tek sayfada, üç sütun halinde 300 öğrencimin okul noları, adları ve soyadları alfabetik sıraya göre sıralanmış durumda. bu 300 öğrenciyi 8 şubeye karışık bir biçimde atabilmek istiyorum. tabii ki böyle bir çözüm excelde mümkünse... biraz daha açıklayayım: A sütununda öğrenci no, B sütununda ad, C sütununda soyad var. ada göre, yani B sütununa göre alfabetik sıralı şu an. toplam 300 satır var. 8 ayrı sınıfa bu öğrencileri nasıl -karıştırarak- dağıtırım?

size ve cevaplayacak arkadaşlara tekrar teşekkürler...

 

[muygun]

Merhaba;
Necdet Bey haklı. (İsimleri doğru olarak paylaşmak zorunda değilsiniz. Benim yaptığım gibi sanal isim oluşturabilirsiniz.)
Yinede eğitime katkı adına dosyanızı ben oluşturdum.
İnceleyin.
İyi çalışmalar.

Not: Sınıflara düşen öğrenci sayılarını hesaplama ile excele buldurdum. Bu sayı sizin için kullanılabilir değilse H1 den itibaren sağa doğru sınıf sayılarını manuel oluşturabilirsiniz.

 

[ariza7]

kardeş çok teşekkürler. harikasınız. elinize emeğinize sağlık

 

[BAZGİRET]

Sınıf listeleri öğrenci numarasına göre sıralanamazmı acaba?

 

[Necdet]

Merhaba,

Bende üzerinde çalışıyordum. Şimdi biraz işim çıktı 1-2 saat içinde umarım tamamlarım.

Erkek / Kız öğrenci sayılarını da dikkate alacak şekilde düşündüm.

 

[Necdet]

Merhaba,

"Öğrenci Listesi" sayfasında Öğrenci No, Adı, Soyadı ve Cinsiyeti olmalı
"Parametre" sayfasında ise Kaç sınıf olduğu belirtilmelidir. Formüllü alanlara dokunmamak gerekir.

Umarım Sınıf oluşturmak için uğraşacan öğretmenlerimize bir katkımız olur.

Sub OgrencileriSiniflaraDagit()
    
    Dim i       As Integer, _
        j       As Integer, _
        k       As Integer, _
        m       As Integer, _
        n       As Integer, _
        SonSat  As Integer, _
        Erk_Adt As Integer, _
        Kiz_Adt As Integer, _
        Snf_Adt As Integer, _
        Adet    As Integer
    
    Dim ShO     As Worksheet, _
        ShP     As Worksheet, _
        ShL     As Worksheet, _
        ShG     As Worksheet
    
    Set ShO = Sheets("Öğrenci Listesi")
    Set ShP = Sheets("Parametre")
    Set ShL = Sheets("Sınıf Listeleri")
    
    Snf_Adt = ShP.Range("C2")
    Erk_Adt = ShP.Range("C6")
    Kiz_Adt = ShP.Range("C7")
    
    On Error Resume Next
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Sheets("Geçici").Delete
    Worksheets.Add After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = "Geçici"
    Set ShG = Sheets("Geçici")
    ShG.Cells.ClearContents
    
    SonSat = ShO.Cells(Rows.Count, "A").End(3).Row
    ShO.Range("A1").CurrentRegion.Copy ShG.Range("A1")
    ShG.Range("D1:D2").Copy ShG.Range("F1")
    
    'rastgele sıra verme
    Randomize
    For i = 2 To SonSat
        ShG.Cells(i, "E") = Int((SonSat * Rnd) + 1)
    Next i
    
    ShG.Range("A2:E" & SonSat).Sort Key1:=ShG.[E1]
    
    ShG.Range("A1:D" & SonSat).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ShG.Range( _
        "F1:F2"), CopyToRange:=ShG.Range("H1"), Unique:=False
    
    ShG.Range("F2") = "K"
    ShG.Range("A1:D" & SonSat).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ShG.Range( _
        "F1:F2"), CopyToRange:=ShG.Range("M1"), Unique:=False
    
    ShL.Cells.ClearContents
    
    For j = 8 To 13 Step 5
        m = 0
        If j = 8 Then
            Adet = Erk_Adt
        Else
            Adet = Kiz_Adt
        End If
        
        For k = 2 To ShG.Cells(Rows.Count, j).End(3).Row + 1 Step Adet
            m = m + 1
            n = (m - 1) * 5 + 1
            i = ShL.Cells(Rows.Count, n).End(3).Row + 1
            If i = 2 Then ShG.Range("H1:K1").Copy ShL.Cells(1, n)
            ShG.Range(ShG.Cells(k, j), ShG.Cells(k + Adet - 1, j + 3)).Copy ShL.Cells(i, n)
        Next k
    Next j
    
    Sheets("Geçici").Delete
    
    For j = 1 To (Snf_Adt - 1) * 5 + 1 Step 5
        i = ShL.Cells(Rows.Count, j).End(3).Row
        ShL.Range(ShL.Cells(2, j), ShL.Cells(i, j + 3)).Sort Key1:=ShL.Cells(1, j)
    Next j
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox "SINIF LİSTELERİ OLUŞURULMUŞTUR, İNCE AYAR YAPABİLİRSİNİZ...", vbInformation, "N. YEŞERTENER...."
    
End Sub

 

[lazr55]

http://www.excel.web.tr/f50/synyf-listesi-duzenleme-t116467.html