TAMAMEN RASTLANTISAL SIRALAMA

halit3 · 29 Kasım 2018

YUSUF44' Alıntı:
Halit Bey, benim hazırladığım kodlarda çok büyük veri olmadığı halde neden donma olduğunu söyleyebilir misiniz? Nerede hata yapıyorum? döngüyü 29 öğrenci için yaptığımda bile excel donuyor maalesef.

Merhaba Sayın YUSUF44 6 nolu mesajdaki kodları hangi mesajdaki dasyada çalıştırıyorsunuz.

halit3 · 29 Kasım 2018

splashsmlt' Alıntı:
HALİT hocam öncelikle ellerinize sağlık.
1) sınıf sayısını çoğaltmak için "sınıf" çalışma sayfasında O2 hücresini atıyorum 23 yapsam yeterli mi?
2) gerçek datayı "data" çalışma sayfasında a1 hücresinden başlayarak aynı formatta yapıştırsam bozulur mu?
3) kullanmak istediğimde c sütununu karıştır dediğimde sınıflarda öğrencilerin yeri de değişir mi?(her yazılı da değişsin istiyorum onun için)
4) sınıflarda bir sırada tek kişi oturacak yani o sınıfta 23 kişi olacak bunu yapabilir miyim?(yada bazı sınıflarda 17 kişilik yapabilir miyim mesela o sınıfta öğrenci sırasından öğrenci silsem o öğrenci tamamen silinir mi ?)

1. sorunuz için 23 yazsanız olmayacaktır sınıflar sizin hazırladığınız tabloda 30 kişi olduğundan kodları buna göre düzenlemek gerekecek.
2. sorunuz olur
3. sorunuz için değişir
4. sorunuz 1. sorunuz ile bağlantılı sınıf sayfasında oturma düzeniniz aşağıya doğru beş yatay altı sıra mevcut

göndermiş olduğum örnek dosyada bu sıralara ait nasıl doldurulmasını istiyorsanız manuel doldurun bir bakalım.
sınıf ismlerinide sınıf sayfasında N sutununa yazınız.

YUSUF44 · 29 Kasım 2018

halit3' Alıntı:
Merhaba Sayın YUSUF44 6 nolu mesajdaki kodları hangi mesajdaki dasyada çalıştırıyorsunuz.

Ekli dosyada mevcut Halit Bey.

splashsmlt · 29 Kasım 2018

halit bey BU HALİYLE BİLE ŞAKINLIK VERİCİ HAYALİM GERÇEK OLDU GİBİ. SADECE BU ÇALIŞMAYI İŞLEVSEL KULLANMAK İÇİN
1) SINIF SAYISI 23 SINIF N SÜTÜNUNA YAZDIM.
2) SINIFLARDA BAZEN 16 BAZEN 17 BAZEN 22 KİŞİ YERLEŞTİREBİLMEK İÇİN BİR AÇIK KAPI BIRAKILABİLİR Mİ?
#18 NOLU İLETİNİZDEKİ ÇALIŞMAYI REFERANS ALARAK SORDUM.
SAYGILAR ELİNİZE SAĞLIK

halit3 · 29 Kasım 2018

YUSUF44' Alıntı:
Ekli dosyada mevcut Halit Bey.

kodun bu bölümleri
GoTo 10
GoTo 20
istenen veri sayısına ulaşamadığı için sonsuz döngüye giriyor.

halit3 · 29 Kasım 2018

splashsmlt' Alıntı:
halit bey BU HALİYLE BİLE ŞAKINLIK VERİCİ HAYALİM GERÇEK OLDU GİBİ. SADECE BU ÇALIŞMAYI İŞLEVSEL KULLANMAK İÇİN
1) SINIF SAYISI 23 SINIF N SÜTÜNUNA YAZDIM.
2) SINIFLARDA BAZEN 16 BAZEN 17 BAZEN 22 KİŞİ YERLEŞTİREBİLMEK İÇİN BİR AÇIK KAPI BIRAKILABİLİR Mİ?
#18 NOLU İLETİNİZDEKİ ÇALIŞMAYI REFERANS ALARAK SORDUM.
SAYGILAR ELİNİZE SAĞLIK

18 nolu mesajdaki dosyada sınıf sayfasına oturma düzenini manuel yap dosyayı buraya ekle ayrıca çöyle bir şeyde olabilir sınıf sayfasında N sutünunda sınıflara ait hemen yanına O sutununa sınıf sayılarıda yazılabilir.

bunlara ilişkin dosyayı derle buraya ekle bir bakalım.

YUSUF44 · 29 Kasım 2018

halit3' Alıntı:
kodun bu bölümleri
GoTo 10
GoTo 20
istenen veri sayısına ulaşamadığı için sonsuz döngüye giriyor.

Teşekkürler Halit Bey. Öğrenci kontrolünü yaparken D sütunu doluysa diye şart koymuşum, halbuki boşsa olmalıydı. Sayenizde hallettim.

Kodun son hali aşağıdaki gibi oldu, şu anda tüm sınıfları doldurarak işlem yapıyor:

PHP:

Sub salonlar()
Set s1 = Sheets("GENEL LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row

uyarı = MsgBox("Eski veriler silinsin mi?", vbYesNo)
If uyarı = vbYes Then
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            Sheets(i).[B14:I14, B16:I16, B18:I18, B20:I20, B22:I22].ClearContents
            s1.Range("D2:D" & son).ClearContents
        End If
    Next
End If

If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
    MsgBox "Boşta kalan öğrenci bulunmamaktadır!"
    Exit Sub
End If

For salon = 1 To Sheets.Count
    If Sheets(salon).Name <> s1.Name Then
        For küme = 2 To 8 Step 3
            For sıra = 14 To 22 Step 2
10:
                öğrenci1 = WorksheetFunction.RandBetween(2, son)
                If s1.Cells(öğrenci1, "D") = "" Then
                    Sheets(salon).Cells(sıra, küme) = s1.Cells(öğrenci1, "C") & Chr(10) & s1.Cells(öğrenci1, "B") & Chr(10) & s1.Cells(öğrenci1, "A")
                    s1.Cells(öğrenci1, "D") = Sheets(salon).Name
                    If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
                        MsgBox "Tüm öğrenciler dağıtıldı"
                        Exit Sub
                    End If
20:
                    öğrenci2 = WorksheetFunction.RandBetween(2, son)
                    If s1.Cells(öğrenci2, "D") = "" And s1.Cells(öğrenci2, "A") <> s1.Cells(öğrenci1, "A") Then
                        Sheets(salon).Cells(sıra, küme + 1) = s1.Cells(öğrenci2, "C") & Chr(10) & s1.Cells(öğrenci2, "B") & Chr(10) & s1.Cells(öğrenci2, "A")
                        s1.Cells(öğrenci2, "D") = Sheets(salon).Name
                        If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
                            MsgBox "Tüm öğrenciler dağıtıldı"
                            Exit Sub
                        End If
                    Else
                        GoTo 20
                    End If
                Else
                    GoTo 10
                End If
            Next
        Next
    End If
Next

If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) > 0 Then
    MsgBox "Öğrenci dağıtımı tamamlandı ancak boşta kalan öğrenci(ler) var!"
Else
    MsgBox "Öğrenci dağıtımı tamamlandı"
End If

End Sub

halit3 · 29 Kasım 2018

18 nolu mesajdaki dosyada sınıf sayfasındaki kod da yanlışlık olduğu için ilgili mesajdaki dosyayı güncelledim.

YUSUF44 · 29 Kasım 2018

Kodları sınıfta olabilecek öğrenci sayısının belirlenebileceği şekilde ayarladım. Son hali aşağıdaki gibidir:

PHP:

Sub salonlar()
Set s1 = Sheets("GENEL LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row

30:
mevcut = InputBox("Her sınıfta kaç öğrenci olmalı?", "Sınıf Kapasitesi", 0)
If IsNumeric(mevcut) = False Then
    MsgBox "Lütfen 1-30 arası tamsayı giriniz!", vbCritical
    GoTo 30
ElseIf mevcut * 1 <> Int(mevcut) Then
    MsgBox "Lütfen 1-30 arası tamsayı giriniz!", vbCritical
    GoTo 30
ElseIf mevcut > 30 Or mevcut < 1 Then
    MsgBox "Bir sınıfta 1-30 arası öğrenci olabilir!", vbCritical
    GoTo 30
End If
uyarı = MsgBox("Eski veriler silinsin mi?", vbYesNo)
If uyarı = vbYes Then
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            Sheets(i).[B14:I14, B16:I16, B18:I18, B20:I20, B22:I22].ClearContents
            s1.Range("D2:D" & son).ClearContents
        End If
    Next
End If

If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
    MsgBox "Boşta öğrenci bulunmamaktadır!"
    Exit Sub
End If

hat = WorksheetFunction.Ceiling(mevcut / 6, 1)
sınıf = hat * 2 + 12
For salon = 1 To Sheets.Count
    If Sheets(salon).Name <> s1.Name Then
        atanan = 0
        For küme = 2 To 8 Step 3
            For sıra = 14 To sınıf Step 2
10:
                öğrenci1 = WorksheetFunction.RandBetween(2, son)
                If s1.Cells(öğrenci1, "D") = "" Then
                    Sheets(salon).Cells(sıra, küme) = s1.Cells(öğrenci1, "C") & Chr(10) & s1.Cells(öğrenci1, "B") & Chr(10) & s1.Cells(öğrenci1, "A")
                    s1.Cells(öğrenci1, "D") = Sheets(salon).Name
                    atanan = atanan + 1
                    If atanan = mevcut * 1 Then
                        GoTo 40
                    End If
                    If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
                        MsgBox "Tüm öğrenciler dağıtıldı"
                        Exit Sub
                    End If
20:
                    öğrenci2 = WorksheetFunction.RandBetween(2, son)
                    If s1.Cells(öğrenci2, "D") = "" And s1.Cells(öğrenci2, "A") <> s1.Cells(öğrenci1, "A") Then
                        Sheets(salon).Cells(sıra, küme + 1) = s1.Cells(öğrenci2, "C") & Chr(10) & s1.Cells(öğrenci2, "B") & Chr(10) & s1.Cells(öğrenci2, "A")
                        s1.Cells(öğrenci2, "D") = Sheets(salon).Name
                        atanan = atanan + 1
                        If atanan = mevcut * 1 Then
                            GoTo 40
                        End If
                        If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
                            MsgBox "Tüm öğrenciler dağıtıldı"
                            Exit Sub
                        End If
                    Else
                        GoTo 20
                    End If
                Else
                    GoTo 10
                End If
            Next
        Next
    End If
40:
Next

If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) > 0 Then
    MsgBox "Öğrenci dağıtımı tamamlandı ancak boşta kalan öğrenci(ler) var!"
Else
    MsgBox "Öğrenci dağıtımı tamamlandı"
End If

End Sub

splashsmlt · 29 Kasım 2018

halit bey
1)N3-N25 ARASI SINIF İSİMLERİ GİRİLDİ
2)O3-O25 ARASI SINIF MEVCUTLARI GİRİLDİ.
SINIF ÇALIŞMA SAYFASINDA 18 VE 19 SATIR FAZLAYDI SİLİNDİ. BU HALİ SON HALİ.

İSTEK: N3-N25 E SINIF EKLEYEBİLME GİBİ BİR KISIM AÇIK BIRAKILABİLİR Mİ? YADA BİR SINIF DAHA EKLEYİM AMA EN SONDA OLDUĞU İÇİN BOŞ OLSA ÖĞRENCİ ARTINCA DOLAR.
BİRDE O3-O23 ARASI SINIF MEVCUTLARI DEĞİŞSEBİLİR. MESELA 9-AB 24 KEN 2 AY SONRA 22 OLDUĞUNDA O SINIFIN MEVCUDUNU 22 YAPINCA O SINAFA 22 YERLEŞTİRSE.

splashsmlt · 29 Kasım 2018

YUSUF44' Alıntı:

Teşekkürler Halit Bey. Öğrenci kontrolünü yaparken D sütunu doluysa diye şart koymuşum, halbuki boşsa olmalıydı. Sayenizde hallettim.

Kodun son hali aşağıdaki gibi oldu, şu anda tüm sınıfları doldurarak işlem yapıyor:

PHP:

Sub salonlar()
Set s1 = Sheets("GENEL LİSTE")
son = s1.Cells(Rows.Count, "A").End(3).Row

uyarı = MsgBox("Eski veriler silinsin mi?", vbYesNo)
If uyarı = vbYes Then
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            Sheets(i).[B14:I14, B16:I16, B18:I18, B20:I20, B22:I22].ClearContents
            s1.Range("D2:D" & son).ClearContents
        End If
    Next
End If

If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
    MsgBox "Boşta kalan öğrenci bulunmamaktadır!"
    Exit Sub
End If

For salon = 1 To Sheets.Count
    If Sheets(salon).Name <> s1.Name Then
        For küme = 2 To 8 Step 3
            For sıra = 14 To 22 Step 2
10:
                öğrenci1 = WorksheetFunction.RandBetween(2, son)
                If s1.Cells(öğrenci1, "D") = "" Then
                    Sheets(salon).Cells(sıra, küme) = s1.Cells(öğrenci1, "C") & Chr(10) & s1.Cells(öğrenci1, "B") & Chr(10) & s1.Cells(öğrenci1, "A")
                    s1.Cells(öğrenci1, "D") = Sheets(salon).Name
                    If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
                        MsgBox "Tüm öğrenciler dağıtıldı"
                        Exit Sub
                    End If
20:
                    öğrenci2 = WorksheetFunction.RandBetween(2, son)
                    If s1.Cells(öğrenci2, "D") = "" And s1.Cells(öğrenci2, "A") <> s1.Cells(öğrenci1, "A") Then
                        Sheets(salon).Cells(sıra, küme + 1) = s1.Cells(öğrenci2, "C") & Chr(10) & s1.Cells(öğrenci2, "B") & Chr(10) & s1.Cells(öğrenci2, "A")
                        s1.Cells(öğrenci2, "D") = Sheets(salon).Name
                        If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) = 0 Then
                            MsgBox "Tüm öğrenciler dağıtıldı"
                            Exit Sub
                        End If
                    Else
                        GoTo 20
                    End If
                Else
                    GoTo 10
                End If
            Next
        Next
    End If
Next

If WorksheetFunction.CountBlank(s1.Range("D2:D" & son)) > 0 Then
    MsgBox "Öğrenci dağıtımı tamamlandı ancak boşta kalan öğrenci(ler) var!"
Else
    MsgBox "Öğrenci dağıtımı tamamlandı"
End If

End Sub

yusuf bey kodu yapıştırdım. çalışıyor fakat benim bir hatamdan dolayı 3.SIRA'dan üst üste iki tane koyduğum için her sınıftan 2 satır sildim. bu durumda da KOD çalışıyor fakat 22. satıra da öğrenci ataması yapıyor. kodunuzda nereyi değiştirmeliyim? dosyanın kodunuzu yapıştırdıkatan sonraki halini ekliyorum.

splashsmlt · 29 Kasım 2018

yusuf bey 29 .iletideki kodunuzu kullandım zannedersem oldu gibi şimdi öğrenci listesini koyup bir deneme yapacağım sonuçtan size hebr vereceğim.

YUSUF44 · 29 Kasım 2018

Yani bir sınıfta en çok 24 kişi olabilir diyorsunuz galiba. bu durumda

ElseIf mevcut > 30 Or mevcut < 1 Then

satırını

ElseIf mevcut > 24 Or mevcut < 1 Then

olarak değiştirirseniz sınıftaki en çok öğrenci sayısını 24'ten fazla girmenize izin vermez.

splashsmlt · 29 Kasım 2018

yusuf hocam kodu denedim çalışıyor. okulumuzda sınıftaki sıra sayısı farklı. mesela bir sınıfta 12 sıra var 24 kişilik bir sınıfta 8 sıra var 16 kişilik. budurumda salonlara atama yaparken sınıfta kaç kişi olsun sorusu soruyor ya onu sırayla şu sınıf kaç olsun atıyorum 24 sıradaki ikinci sınıf kaç olsun 22 sıradakine geçip sorunca 20 yazabilsek. 23. ve son sınıfa kadar bu şekilde olabilir mi ki? OLMASA DA YAPTIKLARINIZI AYAKTA ALKIŞLIYORUM. ÜSTAD BİRİNE HAYAL ET DESEM EDEMEZ SİZ KODUNU YAZIYORSUNUZ. BİR ÖĞRETMEN OLARAK AYAKTA ALKIŞLIYORUM HALİT BEY VE SİZİ SAYGILARIMLA...

YUSUF44 · 29 Kasım 2018

Estağfurullah.

Eğer öyle olmasını istiyorsanız Halit Bey'in mantığını uygulamak daha iyi olacaktır. Bir sayfada liste halinde hangi sınıfta en fazla kaç kişi olabilieceğini belirtip dağıtımını ana sayfada yaptıktan sonra, istediğiniz sınıfın oturma planını seçerek yükletebilirsiniz.

3 sayfa olacak, biri öğrenci listesi, biri oturma planı biri de temel bilgiler yani hangi sınıfın kaç kişilik olduğunu gösterir liste.
Dağıtım makrosu çalışınca öğrenci listesinde öğrencilerin hangi sınıfta ve hangi sırada oturacağını belirler.
oturma planı sayfasında istenen sınıf seçildiğinde o sınıfta sınava girecek öğrenciler oturma planına yüklenir, gerekirse sınıf kapasitesine göre fazlalık sıralar gizlenir.
isterseniz buna göre dosyanızı güncelleyin, üstünde çalışalım.

halit3 · 29 Kasım 2018

Ekli dosyayı irdeleyiniz.
sınıf sayfasında kaydırıcı düğme ile ilgili satır seçiliyor ve aktar düğmesine tıklayınca ilgili satır numarasındaki bilgiler geliyor.

not: satır numarası 2 iken veriler sizin birinci satırdaki yani ikinci sıradaki ilk bilgileri getirir.

splashsmlt · 29 Kasım 2018

yusuf bey sınıfları 12 sıra 24 kişilik yaptığımızda yani hepsini standart hale getirdiğimizde harika olacak. Ellerinize sağlık. üstad hiç tanımadığınız birine yardım ediyorsunuz saygıyla karşılıyorum teşekkürler. tıkır tıkır çalışıyor kodunuz. Halit hocam sınıfları istediğim gibi ayarlayabiliyorum elleriniz dert görmesin. teşekkürler üstadlar.
KOD YAZMAYA BAŞLAMAK İÇİN NEREDEN BAŞLAMALIYIM VAKTİM BOLCA VAR. TAVSİYENİZE İHTİYACIM VAR

halit3 · 29 Kasım 2018

splashsmlt' Alıntı:
KOD YAZMAYA BAŞLAMAK İÇİN NEREDEN BAŞLAMALIYIM VAKTİM BOLCA VAR. TAVSİYENİZE İHTİYACIM VAR

Birazcık sabır etmek gerekiyor
hiç bir şey bilmeden bu iş baya zor gözüküyor mokrolarla ilgili bir kitap alın ve veb sitelerini takip edin ayrıca excellin makro kaydet olayı var excellde yaptığın her şeyi bu makro kaydet bölümü kayıt yapıyor sonrada makrolarını sonlandır ve mokrolar ne iş yapmış kontrol et.

splashsmlt · 29 Kasım 2018

halit hocam teşekkürler ölmessem 5-10 yılım varyavaş yavaş öğreneceğim. son olarak dolu hücreleri saydırmak için =BAĞ_DEĞ_DOLU_SAY(B14;C14;E14;F14;H14;I14;B16;C16;E16;F16;H16;I16;B18;C18;E18;F18;H18;I18;B20;C20;E20;F20;H20;I20) şunu kullandım. ama sayfayı aktar yapıp başka sayfa gelince sınıf mevcudu değişmiyor. sitede dolu hücre say diye arattım bulamadım.

halit3 · 29 Kasım 2018

splashsmlt' Alıntı:
halit hocam teşekkürler ölmessem 5-10 yılım varyavaş yavaş öğreneceğim. son olarak dolu hücreleri saydırmak için =BAĞ_DEĞ_DOLU_SAY(B14;C14;E14;F14;H14;I14;B16;C16;E16;F16;H16;I16;B18;C18;E18;F18;H18;I18;B20;C20;E20;F20;H20;I20) şunu kullandım. ama sayfayı aktar yapıp başka sayfa gelince sınıf mevcudu değişmiyor. sitede dolu hücre say diye arattım bulamadım.

Bu söylediğin benim gönderdiğim dosyada mı oluyor

TAMAMEN RASTLANTISAL SIRALAMA

halit3

Uzman

halit3

Uzman

YUSUF44

Destek Ekibi

Ekli dosyalar

splashsmlt

halit3

Uzman

halit3

Uzman

YUSUF44

Destek Ekibi

halit3

Uzman

YUSUF44

Destek Ekibi

splashsmlt

Ekli dosyalar

splashsmlt

Ekli dosyalar

splashsmlt

YUSUF44

Destek Ekibi

splashsmlt

YUSUF44

Destek Ekibi

halit3

Uzman

Ekli dosyalar

splashsmlt

halit3

Uzman

splashsmlt

halit3

Uzman