Gruplara ayırma

[erdenek]

Arkadaşlar merhaba.ekte bir örneğini paylaştığım dosyada 250 kişiyi gruplara dağıtmam lazım. her grup 4 kişi olacak gruplara dağıtım yapıldıktan sonra artan olursa veya eksilen olursa gruptaki kişi sayısı 5 olabilir. Yardımlarınızı bekliyorum.

 

[bycakir]

buradakı anlatım işinizi görecektir

 

[ÖmerFaruk]

250 kişi dediğiniz C sütununda örnek olarak yazdığınız 4 kişi midir?
Gruplara bir grup nosu mu verilecek ya da oluşan gruplar nereye nasıl yazılacak?

 

[erdenek]

ÜSTAD GRUPLARA NUMARA VERİLECEK.BEN 250 İSİM YAZMADIM ÖRNEK OLSUN DİYE 4 İSİM YAZDIM AMA 250 KİŞİ OLACAK

 

[ÖmerFaruk]

Merhaba,
Lütfen büyük harf kullanmayın.

248 4ün katı, 62 grup oluyor
Formül ya da makroyla çözüm bulurken;
249 kişi varsa son grup 1 kişi mi olacak, yoksa 4 kişi olmadan yeni grup açılmayacak mı? Ya da nasıl bir kuralınız olacak?

 

[erdenek]

Üstadım gruplar olusturulduktan sonra kalan kişi sayısı 4 kişiden az ise yeni grup açmadan diğer gruplara dağıtılsın. Yani bu durumda bazı gruplar 4 den fazla olabilir.

 

[ÖmerFaruk]

Merhaba. İşlerim vardı ancak dönebildim. (söz meclisden dışarı, bu aralar sorulara zamanında cevap veremeyince fırça yiyoruz kullancılardan)
Dosyanız ekte ayrıca kodlar da aşağıda.

Sub Grupla()
Dim Veri, myDict As Object, myList

    Veri = Range("B1").CurrentRegion.Value              'Mevcut verileri kopyalıyoruz
    ReDim myList(1 To UBound(Veri) - 1, 1 To 1)         'Grupları yazacağımız liste boyutunu ayarlıyoruz
    Set myDict = CreateObject("Scripting.Dictionary")   'Dictionary nesnesi tanımlıyoruz
    MaxGrp = Int((UBound(Veri) - 1) / 4)                'Oluşabilecek maksimum grup numarasını buluyoruz
    Grup = 1                                            'ilk grup nosunu manuel veriyoruz
    For i = 2 To UBound(Veri)                           'Dizideki verikeri Dictionary nesnesine kopyalıypruz
        myDict.Add i - 1, Veri(i, 3) & " - " & i - 1
    Next i

    Do
        Randomize                                       'Rastgele sayı üretim süreci başlangıcı
        Sec = Int((myDict.Count * Rnd) + 1)             'grubun atanacağı öğrenci sırasını seçiyoruz
        myList(myDict.Keys()(Sec - 1), 1) = Grup        'Listemize bu öğrencinin sırasına grup nosunu yazıyoruz
        GrupSay = GrupSay + 1                           '4 öğrenciden oluacaan gruplardaki öğrenci sayısını sayıyoruz
        myDict.Remove myDict.Keys()(Sec - 1)            'atanan öğrenciyi dictionaryden siliyoruz
        If GrupSay = 4 And Not Grup = MaxGrp Then       'Eğer öğrenci sayısı 4 ve son gruuba ulaşılmamışsa
            GrupSay = 0                                 'Gruptaki öğrenci sayısını sıfırlıyor ve yeni grup numarası veriyoruz
            Grup = Grup + 1
        ElseIf GrupSay >= 4 Then                        'Eğer son grup da dolmuş yani öğrenci sayısı grup sayısının 4 katından fazla ise
            Randomize                                   'Kalan öğrencilerin her biri için mevcut gruplardan rastgele grup numarası seçiyoruz
            Grup = Int((MaxGrp * Rnd) + 1)
        End If
    Loop Until myDict.Count = 0                         'Do - Loop döngüsünde grup atanacak öğrenci kalmamışsa sonlandırıyoruz
    Range("D2").Resize(UBound(Veri) - 1, 1) = myList    'Grup listesini sayfaya D sütununa yazıyoruz
End Sub

 

[erdenek]

Üstad çok teşekkür ederim. Ellerinize sağlık