• DİKKAT

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

Soru 3 Gruplu Kurallı Liste Oluşturmak

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
745
Excel Vers. ve Dili
2016 64 TR
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.
 
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.
 

Ekli dosyalar

Son düzenleme:
ÖmerFaruk' Alıntı:
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.
Genişletmek için tıkla ...
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.
 
Aynı formülü bir döngüyle makroyla uygulayabilirsiniz.
 
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.


C++: 
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
 
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.
 
Kod: 
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
 
Son düzenleme:

Ekli dosyalar

veyselemre' Alıntı:
Kod: 
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
Genişletmek için tıkla ...

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
 

Ekli dosyalar

Kod: 
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' Alıntı:
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
Genişletmek için tıkla ...
@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
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst