Soru 3 Gruplu Kurallı Liste Oluşturmak

[TURKOLOG]

Excelde devam eden bir listem var bu listeyi macro
ile yapmak mümkün mü.
Örnek dosya ekte.
Harici Dosya Silinebilir.
Yani butona basınca A hücresindeki tarihe
Göre mevcut sıralamayı yapacak
Bir kaç ayın çizelgesini ekledim.

Kısaca her grup 5 gündüz üst üste geliyor
Diğer gruplar da bir gece çalışıp bir gece istirahat ediyor.
Yardım edebilecek olan varsa çok sevinirim.
Harici Dosya Silinebilir.

 

[ÖmerFaruk]

Formül çok kasmıyorsa kullanabilirsiniz

İlk satırınıza
B3 hücresine 1, C3 hücresine 2, D3 hücresine 3 yazın.

B4 hücresine
=EĞER(MOD(EĞERSAY($B$3:B3;B3);5)=0;D3;B3)

C4 Hücresine
=6-B4-C3

D4 hücresine
=6-B4-C4

Yazın

B-C-D sütunlarının komple seçin ve hücre biçimlendirme kısmında, isteğe uyarlanmış, aşağıdakini yapıştırın.
0".Grup"

4.satırdaki formüllerinizi seçin aşağı doğru sürükleyerek çoğaltabilirisiniz.

 

[TURKOLOG]

Formül çok kasmıyorsa kullanabilirsiniz

İlk satırınıza
B3 hücresine 1, C3 hücresine 2, D3 hücresine 3 yazın.

B4 hücresine
=EĞER(MOD(EĞERSAY($B$3:B3;B3);5)=0;D3;B3)

C4 Hücresine
=6-B4-C3

D4 hücresine
=6-B4-C4

Yazın

B-C-D sütunlarının komple seçin ve hücre biçimlendirme kısmında, isteğe uyarlanmış,o aşağıdakini yapıştırın.
0".Grup"

4.satırdaki formüllerinizi seçin aşağı doğru sürükleyerek çoğaltabilirisiniz.

Hocam elinize emeğinize sağlık. Çok teşekkür ederim. Ama 1 yıllık şeklinde planladığın için makro olması benim için daha iyi olacak.
Bu yüzden makrolu bir çözüm arıyorum Hocam.

 

[ÖmerFaruk]

Aynı formülü bir döngüyle makroyla uygulayabilirsiniz.

 

[TURKOLOG]

Aynı formülü bir döngüyle makroyla uygulayabilirsiniz.

Hocam yapabilseydim. Ama malesef elimden gelmiyor.

 

[ÖmerFaruk]

Aşağıdaki kodları kullanabilirsin.

Not 1:
B-C-D sütunlarının komple seçin ve hücre biçimlendirme kısmında, isteğe uyarlanmış, aşağıdakini yapıştırın. 0".Grup"

Not 2:
Tarihler 3.satırdan başlayacak.
Siz ilk satırda grup belirtmenize gerek yok. Grupların sıralaması da 1-2-3 şeklinde otomatik olarak kod tarafından yapılacak.
İlk grupları değişmek isterseniz kod içinde başlangıç değerlerini kaydırabilirsiniz.

Sub Cizelge()
Dim dizim As Variant
Son = Range("A" & Rows.Count).End(3).Row

ReDim dizim(1 To Son - 2, 1 To 3)
Range("B3:D" & Son).ClearContents

gr1 = 1
gr2 = 2
gr3 = 3
For i = 3 To Son Step 5
    For k = i To i + 4
        dizim(k - 2, 1) = gr1
        dizim(k - 2, 2) = 6 - gr1 - gr3
        dizim(k - 2, 3) = gr3
        Ara = gr2
        gr2 = gr3
        gr3 = Ara
    Next k
    Ara = gr1
    gr1 = gr2
    gr2 = Ara
Next i
Range("B3:D" & Son) = dizim
End Sub

 

[TURKOLOG]

Hocam
For k =i To i +4
dizim(k-2,1)=grl

kırmızı satırda üzerine gelince
dizim(k-2,1)=<Subscript out of range>
uyarısı veriyor.

 

[veyselemre]

Sub test2()
    Dim i&, gruplar()
    gruplar = Array("", "1. GRUP", "2. GRUP", "3. GRUP")
    Range("B3:D" & Rows.Count).ClearContents
    For i = 3 To Cells(Rows.Count, 1).End(3).Row Step 5
        Cells(i, 2).Resize(5).Value = gruplar(1)
        For ii = 0 To 4
            Cells(i + ii, 3).Value = gruplar(2)
            Cells(i + ii, 4).Value = gruplar(3)
            gruplar(0) = gruplar(2)
            gruplar(2) = gruplar(3)
            gruplar(3) = gruplar(0)
        Next ii
            gruplar(0) = gruplar(1)
            gruplar(1) = gruplar(2)
            gruplar(2) = gruplar(0)
    Next i
End Sub

 

[ÖmerFaruk]

Hocam
For k =i To i +4
dizim(k-2,1)=grl

kırmızı satırda üzerine gelince
dizim(k-2,1)=<Subscript out of range>
uyarısı veriyor.

Kodları tekrar çalıştırdım sorun göremedim. Sanırım kopyalarken hata yapıyorsunuz.
Dosyayı da ekliyorum

https://dosya.co/rzgmbziadant/Yıllık_Çizelge.xlsm.html

 

[TURKOLOG]

@ÖmerFaruk Hocam ve @veyselemre Hocam ellerinize sağlık. Iki kodda çalıştı. Eliniz dert görmesin inşallah

 

[TURKOLOG]

Sub test2()
    Dim i&, gruplar()
    gruplar = Array("", "1. GRUP", "2. GRUP", "3. GRUP")
    Range("B3:D" & Rows.Count).ClearContents
    For i = 3 To Cells(Rows.Count, 1).End(3).Row Step 5
        Cells(i, 2).Resize(5).Value = gruplar(1)
        For ii = 0 To 4
            Cells(i + ii, 3).Value = gruplar(2)
            Cells(i + ii, 4).Value = gruplar(3)
            gruplar(0) = gruplar(2)
            gruplar(2) = gruplar(3)
            gruplar(3) = gruplar(0)
        Next ii
            gruplar(0) = gruplar(1)
            gruplar(1) = gruplar(2)
            gruplar(2) = gruplar(0)
    Next i
End Sub

Hocam bu kodu 4 grup için nasıl revize edebiliriz acaba
Grup Yerleştirme İşlemine Başla butonuna tıklayınca
Görev listesi C4 I19 arasını temizleyecek
Sonra görev listesi sayfası B sütununda tarih yazan satırlar için data sayfası C D E F Sütunlarındaki yazili 1. Grup 2. Grup 3. Grup 4. Grup yazılanın üstündeki Gündüz Görevli Gece Görevli Geceden Çıktı istirahatli Gündüzden cıktı istirahati yazısını görev listesi sayfası F G H I Sütunlarına yazacak şekilde

Yardımcı olabilir misiniz Hocam

 

[veyselemre]

Sub Sayfaya_Aktar()
    Dim sG As Worksheet, lst, i&, ii%, krt$

    Set sG = Sheets("GÖREV LİSTESİ")
    sG.Range("C4:I19").ClearContents

    With Sheets("DATA")
        lst = .Range("B1:F" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    With CreateObject("Scripting.Dictionary")

        For i = 2 To UBound(lst)
            For ii = 2 To 5
                krt = lst(i, 1) & vbTab & lst(i, ii)
                .Item(krt) = lst(1, ii)
            Next ii
        Next i

        For i = 4 To sG.Cells(Rows.Count, "B").End(3).Row
            For ii = 6 To 9
                krt = sG.Cells(i, "B").Value & vbTab & sG.Cells(3, ii).Value
                If .exists(krt) Then sG.Cells(i, ii).Value = .Item(krt)
            Next ii
        Next i

    End With
    
End Sub

 

[TURKOLOG]

Hocam kodu deneyip size bilgi vereyim

 

[TURKOLOG]

Hocam bu kodu 4 grup için nasıl revize edebiliriz acaba
Grup Yerleştirme İşlemine Başla butonuna tıklayınca
Görev listesi C4 I19 arasını temizleyecek
Sonra görev listesi sayfası B sütununda tarih yazan satırlar için data sayfası C D E F Sütunlarındaki yazili 1. Grup 2. Grup 3. Grup 4. Grup yazılanın üstündeki Gündüz Görevli Gece Görevli Geceden Çıktı istirahatli Gündüzden cıktı istirahati yazısını görev listesi sayfası F G H I Sütunlarına yazacak şekilde

Yardımcı olabilir misiniz Hocam

@veyselemre Hocam vakti ile 3 lü çalışma sistemini siz yapmıştınız ve 1 yıldan fazla süredir kullanıyorum. Şu an 4 lü grup çalışma sistemine geçtik
Aynı mantıkla 4lu çalışma sistemini revize edebilir misiniz