Vardiyaları Sıralama

[yanginci34]

Arkadaşlar merhaba; Örnek dosyamda olamasını istediğimi şöyle açıklayayım, B-A ve C-D vardiyaları pazar ile cuma günleri arası sırasıyla devam ediyor cumartesi günleri E-F vardiyaları var bunlar 1. hafta B-A cumartesi günü E-F 2. hafta A-B cumartesi günü F-E 3. Hafta C-D cumartesi günü E-F 4. hafta D-C cumartesi günü F-E olarak ayı değiştirdiğimde yazdıra bilirmiyiz.

 

[tugkan]

Merhaba,
Örnek dosyayı inceleyemedim ama aşağıdaki kodu deneyip sonucu paylaşır mısınız?

Excel'de belirttiğiniz vardiya düzenini oluşturmak için bir formül veya VBA makrosu kullanabilirsiniz. Anladığım kadarıyla, her hafta belirli bir düzende vardiyaların sıralandığı bir yapı istiyorsunuz. Bu yapıyı oluşturan bir VBA makrosu örneği aşağıda verilmiştir.

VBA Makrosu

1. Excel dosyanızı açın.
2. Alt + F11 tuşlarına basarak VBA editörünü açın.
3. Ekle > Modül seçeneği ile yeni bir modül oluşturun.
4. Aşağıdaki kodu yapıştırın:

Sub VardiyaDuzeni()
    Dim ws As Worksheet
    Dim hafta As Integer
    Dim satir As Integer
    Dim vardiya As String
    
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını uygun şekilde değiştirin
    ws.Cells.Clear ' Önceki verileri temizle
    
    ' Vardiya düzeni için başlıkları yaz
    ws.Cells(1, 1).Value = "Hafta"
    ws.Cells(1, 2).Value = "Vardiya"
    
    ' Vardiyaları belirle
    For hafta = 1 To 4
        Select Case hafta
            Case 1
                vardiya = "B-A, E-F"
            Case 2
                vardiya = "A-B, F-E"
            Case 3
                vardiya = "C-D, E-F"
            Case 4
                vardiya = "D-C, F-E"
        End Select
        
        ' Vardiya düzenini yaz
        satir = hafta + 1
        ws.Cells(satir, 1).Value = hafta
        ws.Cells(satir, 2).Value = vardiya
    Next hafta
End Sub

1. F5 tuşuna basarak makroyu çalıştırın.

Açıklama

• Bu makro, "Sayfa1" adlı sayfayı temizler ve her hafta için vardiya düzenini yazar.
• Vardiyaların yazılacağı sayfa adını ihtiyacınıza göre değiştirin.
• Hafta sayısını ve vardiyaları değiştirmek isterseniz, Select Case yapısındaki haftaları düzenleyebilirsiniz.

Sonuç
Bu makro çalıştırıldığında, belirtilen vardiya düzeni belirtilen sayfada oluşturulacak ve görünür hale gelecektir. İsterseniz bu kodu daha da özelleştirebiliriz.

 

[yanginci34]

Merhaba,
Örnek dosyayı inceleyemedim ama aşağıdaki kodu deneyip sonucu paylaşır mısınız?

Excel'de belirttiğiniz vardiya düzenini oluşturmak için bir formül veya VBA makrosu kullanabilirsiniz. Anladığım kadarıyla, her hafta belirli bir düzende vardiyaların sıralandığı bir yapı istiyorsunuz. Bu yapıyı oluşturan bir VBA makrosu örneği aşağıda verilmiştir.

VBA Makrosu

1. Excel dosyanızı açın.
2. Alt + F11 tuşlarına basarak VBA editörünü açın.
3. Ekle > Modül seçeneği ile yeni bir modül oluşturun.
4. Aşağıdaki kodu yapıştırın:

Sub VardiyaDuzeni()
    Dim ws As Worksheet
    Dim hafta As Integer
    Dim satir As Integer
    Dim vardiya As String
   
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını uygun şekilde değiştirin
    ws.Cells.Clear ' Önceki verileri temizle
   
    ' Vardiya düzeni için başlıkları yaz
    ws.Cells(1, 1).Value = "Hafta"
    ws.Cells(1, 2).Value = "Vardiya"
   
    ' Vardiyaları belirle
    For hafta = 1 To 4
        Select Case hafta
            Case 1
                vardiya = "B-A, E-F"
            Case 2
                vardiya = "A-B, F-E"
            Case 3
                vardiya = "C-D, E-F"
            Case 4
                vardiya = "D-C, F-E"
        End Select
       
        ' Vardiya düzenini yaz
        satir = hafta + 1
        ws.Cells(satir, 1).Value = hafta
        ws.Cells(satir, 2).Value = vardiya
    Next hafta
End Sub

1. F5 tuşuna basarak makroyu çalıştırın.

Açıklama

• Bu makro, "Sayfa1" adlı sayfayı temizler ve her hafta için vardiya düzenini yazar.
• Vardiyaların yazılacağı sayfa adını ihtiyacınıza göre değiştirin.
• Hafta sayısını ve vardiyaları değiştirmek isterseniz, Select Case yapısındaki haftaları düzenleyebilirsiniz.

Sonuç
Bu makro çalıştırıldığında, belirtilen vardiya düzeni belirtilen sayfada oluşturulacak ve görünür hale gelecektir. İsterseniz bu kodu daha da özelleştirebiliriz.

İlginiz için öncelikle teşekkür ederim fakat istediğim bu değil benim örnek dosyamda A sütununda alt alta 6. satırdan itibaren bulunduğumuz ayın ilk gününden başlayarak ayın sonuna kadar tarihler var ( her tarih için 2 satır kullanıldı hücre birleştirmeyle ) tarihlerin karşısına B sütunu ( 4-12 vardiyası) C sütunu (12-8 vardiyası ) vardiyalar yazılı olması gerekiyor.

 

[tugkan]

Umarım bu sefer olmuştur. Dener misiniz.

Verdiğiniz açıklamaya göre, tarihlerin karşısına belirli bir vardiya düzeni eklemek istiyorsunuz. A sütununda tarihler varken, B ve C sütunlarına sırasıyla 4-12 ve 12-8 vardiyalarını otomatik olarak yazdıracak bir VBA makrosu hazırlayabiliriz.

Vardiya Döngüsü

• Haftalık vardiya düzeni şu şekilde:
  • Pazar - Cuma günleri B-A ve C-D vardiyaları devam eder.
  • Cumartesi günü ise 1. haftada E-F, 2. haftada F-E, 3. haftada E-F, 4. haftada F-E.

Her hafta başına gelen cumartesi günü için de vardiya döngüsünü buna göre ayarlayabiliriz.

Sub VardiyaDuzeniOtomatik()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim vardiyaHaftasi As Integer
    Dim gunAdi As String
    
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını ihtiyacınıza göre düzenleyin
    
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(6, 1).Value ' 6. satırdan başlıyor
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ay sonu
    
    satir = 6 ' 6. satırdan başla
    haftaSayaci = 1
    
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i))
        
        ' Vardiyaları belirle
        Select Case gunAdi
            Case "Pazar", "Pazartesi", "Salı", "Çarşamba", "Perşembe", "Cuma"
                ' Normal hafta içi vardiyaları
                If haftaSayaci Mod 2 = 1 Then
                    ws.Cells(satir, 2).Value = "B"
                    ws.Cells(satir, 3).Value = "A"
                Else
                    ws.Cells(satir, 2).Value = "C"
                    ws.Cells(satir, 3).Value = "D"
                End If
            Case "Cumartesi"
                ' Cumartesi vardiyaları
                Select Case haftaSayaci
                    Case 1
                        ws.Cells(satir, 2).Value = "E"
                        ws.Cells(satir, 3).Value = "F"
                    Case 2
                        ws.Cells(satir, 2).Value = "F"
                        ws.Cells(satir, 3).Value = "E"
                    Case 3
                        ws.Cells(satir, 2).Value = "E"
                        ws.Cells(satir, 3).Value = "F"
                    Case 4
                        ws.Cells(satir, 2).Value = "F"
                        ws.Cells(satir, 3).Value = "E"
                End Select
        End Select
        
        ' Her gün için 2 satır ayrıldığından bir satır atla
        satir = satir + 2
        
        ' Her cumartesiden sonra hafta sayacını artır
        If gunAdi = "Cumartesi" Then
            haftaSayaci = haftaSayaci + 1
            If haftaSayaci > 4 Then haftaSayaci = 1 ' 4 hafta sonrası başa dön
        End If
    Next i
End Sub

Açıklama:

• A sütunundaki tarihler ayın ilk gününden son gününe kadar otomatik olarak alınıyor.
• B sütunu (4-12 vardiyası) ve C sütunu (12-8 vardiyası) uygun şekilde dolduruluyor.
• Cumartesi günlerinde belirttiğiniz haftalık döngüye göre vardiya yerleşimi yapılıyor (E-F, F-E, E-F, F-E).
• Her gün için 2 satır kullanılıyor ve satır atlaması buna göre yapılıyor.

1. F5 tuşuna basarak makroyu çalıştırın.

Bu makro çalıştırıldığında, belirtilen vardiya düzeni A sütunundaki tarihlerin karşısına otomatik olarak eklenecektir

 

[yanginci34]

Umarım bu sefer olmuştur. Dener misiniz.

Verdiğiniz açıklamaya göre, tarihlerin karşısına belirli bir vardiya düzeni eklemek istiyorsunuz. A sütununda tarihler varken, B ve C sütunlarına sırasıyla 4-12 ve 12-8 vardiyalarını otomatik olarak yazdıracak bir VBA makrosu hazırlayabiliriz.

Vardiya Döngüsü

• Haftalık vardiya düzeni şu şekilde:
  • Pazar - Cuma günleri B-A ve C-D vardiyaları devam eder.
  • Cumartesi günü ise 1. haftada E-F, 2. haftada F-E, 3. haftada E-F, 4. haftada F-E.

Her hafta başına gelen cumartesi günü için de vardiya döngüsünü buna göre ayarlayabiliriz.

Sub VardiyaDuzeniOtomatik()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim vardiyaHaftasi As Integer
    Dim gunAdi As String
   
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını ihtiyacınıza göre düzenleyin
   
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(6, 1).Value ' 6. satırdan başlıyor
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ay sonu
   
    satir = 6 ' 6. satırdan başla
    haftaSayaci = 1
   
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i))
       
        ' Vardiyaları belirle
        Select Case gunAdi
            Case "Pazar", "Pazartesi", "Salı", "Çarşamba", "Perşembe", "Cuma"
                ' Normal hafta içi vardiyaları
                If haftaSayaci Mod 2 = 1 Then
                    ws.Cells(satir, 2).Value = "B"
                    ws.Cells(satir, 3).Value = "A"
                Else
                    ws.Cells(satir, 2).Value = "C"
                    ws.Cells(satir, 3).Value = "D"
                End If
            Case "Cumartesi"
                ' Cumartesi vardiyaları
                Select Case haftaSayaci
                    Case 1
                        ws.Cells(satir, 2).Value = "E"
                        ws.Cells(satir, 3).Value = "F"
                    Case 2
                        ws.Cells(satir, 2).Value = "F"
                        ws.Cells(satir, 3).Value = "E"
                    Case 3
                        ws.Cells(satir, 2).Value = "E"
                        ws.Cells(satir, 3).Value = "F"
                    Case 4
                        ws.Cells(satir, 2).Value = "F"
                        ws.Cells(satir, 3).Value = "E"
                End Select
        End Select
       
        ' Her gün için 2 satır ayrıldığından bir satır atla
        satir = satir + 2
       
        ' Her cumartesiden sonra hafta sayacını artır
        If gunAdi = "Cumartesi" Then
            haftaSayaci = haftaSayaci + 1
            If haftaSayaci > 4 Then haftaSayaci = 1 ' 4 hafta sonrası başa dön
        End If
    Next i
End Sub

Açıklama:

• A sütunundaki tarihler ayın ilk gününden son gününe kadar otomatik olarak alınıyor.
• B sütunu (4-12 vardiyası) ve C sütunu (12-8 vardiyası) uygun şekilde dolduruluyor.
• Cumartesi günlerinde belirttiğiniz haftalık döngüye göre vardiya yerleşimi yapılıyor (E-F, F-E, E-F, F-E).
• Her gün için 2 satır kullanılıyor ve satır atlaması buna göre yapılıyor.

1. F5 tuşuna basarak makroyu çalıştırın.

Bu makro çalıştırıldığında, belirtilen vardiya düzeni A sütunundaki tarihlerin karşısına otomatik olarak eklenecektir

Hocam günaydın; E-F vardiyaları cuma günü başlıyor diğer vardiyalar cumartesi başlıyor hatamızın biri bu birde ben kısaca şöyle örnek vereyim örneğin A vardiyası 1. hafta 4-12 2. hafta 12-8 3. ve 4. hafta da listede olmaması gerekiyor. Ben sizden özür diliyorum sizleri yordum hakkınızı helal edin.

 

[tugkan]

Günaydın,
Yapay zekaya sordum aşağıdaki gibi cevap verdi umarım olmuştur.

Verdiğiniz dosya ve açıklamalarınıza göre hataları düzelterek vardiya düzeninizi istediğiniz gibi ayarlayacağım. Şu an için E-F vardiyalarının cuma günü başlaması ve diğer vardiyaların cumartesi başlaması gerekmekte, ayrıca bazı vardiyaların belirli haftalarda farklı vardiya saatlerinde yer alması ya da hiç listede olmaması durumu var.
İlk önce dosyayı inceleyip, gerekli düzenlemeleri yapacak bir VBA makrosu hazırlayacağım. Birkaç dakika içerisinde dönüş yapacağım.
Dosyanızda vardiya listesinin yapısı belirginleşti. A sütununda tarihler, B ve C sütunlarında 4-12 ve 12-8 vardiya saatleri bulunuyor. Ayrıca, bazı diğer sütunlar da mevcut.
Verilen hatalar doğrultusunda:

1. E-F vardiyaları cuma günü başlamalı.
2. Diğer vardiyalar cumartesi başlamalı.
3. A vardiyasının ilk hafta 4-12, ikinci hafta 12-8 olması, sonraki haftalarda ise listede olmaması gerekiyor.

Plan:

1. E-F vardiyaları cuma günleri başlatılacak.
2. Diğer vardiyalar cumartesi günleri başlayacak.
3. A vardiyası için ilk hafta 4-12, ikinci hafta 12-8 olacak ve 3. ve 4. haftalarda listede yer almayacak.

Birazdan uygun VBA kodunu hazırlayarak bunu dosyanıza uygulayabilmenizi sağlayacağım.
Aşağıda dosyanızdaki isteğinizi yerine getirecek bir VBA makrosu yer alıyor. Bu makro, belirttiğiniz kurallara göre vardiya dağılımını ayarlayacak.

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
    
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
    
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
    
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
        
        ' Vardiyaları belirle
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case "Cumartesi"
                ' Cumartesi günleri diğer vardiyalar
                Select Case haftaSayaci
                    Case 1
                        ws.Cells(satir, 2).Value = "B"
                        ws.Cells(satir, 3).Value = "A"
                    Case 2
                        ws.Cells(satir, 2).Value = "A"
                        ws.Cells(satir, 3).Value = "B"
                    Case 3
                        ws.Cells(satir, 2).Value = "C"
                        ws.Cells(satir, 3).Value = "D"
                    Case 4
                        ws.Cells(satir, 2).Value = "D"
                        ws.Cells(satir, 3).Value = "C"
                End Select
                haftaSayaci = haftaSayaci + 1
                If haftaSayaci > 4 Then haftaSayaci = 1 ' 4 haftalık döngü
            Case Else
                ' Diğer günler için boş bırak
                ws.Cells(satir, 2).Value = ""
                ws.Cells(satir, 3).Value = ""
        End Select
        
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
End Sub

Açıklama:

• E-F vardiyaları cuma günleri başlıyor: Cuma günlerinde "E" ve "F" vardiyaları otomatik olarak atanıyor.
• Diğer vardiyalar cumartesi başlıyor: Cumartesi günlerinde belirtilen haftalara göre B-A, A-B, C-D, D-C vardiya döngüsü çalışıyor.
• Her gün için 2 satır kullanılıyor: Hücre birleştirildiği için her iki satırda bir dolduruluyor.

Bu makroyu çalıştırarak dosyanızdaki vardiya düzenini otomatik hale getirebilirsiniz.

 

[yanginci34]

Günaydın,
Yapay zekaya sordum aşağıdaki gibi cevap verdi umarım olmuştur.

Verdiğiniz dosya ve açıklamalarınıza göre hataları düzelterek vardiya düzeninizi istediğiniz gibi ayarlayacağım. Şu an için E-F vardiyalarının cuma günü başlaması ve diğer vardiyaların cumartesi başlaması gerekmekte, ayrıca bazı vardiyaların belirli haftalarda farklı vardiya saatlerinde yer alması ya da hiç listede olmaması durumu var.
İlk önce dosyayı inceleyip, gerekli düzenlemeleri yapacak bir VBA makrosu hazırlayacağım. Birkaç dakika içerisinde dönüş yapacağım.
Dosyanızda vardiya listesinin yapısı belirginleşti. A sütununda tarihler, B ve C sütunlarında 4-12 ve 12-8 vardiya saatleri bulunuyor. Ayrıca, bazı diğer sütunlar da mevcut.
Verilen hatalar doğrultusunda:

1. E-F vardiyaları cuma günü başlamalı.
2. Diğer vardiyalar cumartesi başlamalı.
3. A vardiyasının ilk hafta 4-12, ikinci hafta 12-8 olması, sonraki haftalarda ise listede olmaması gerekiyor.

Plan:

1. E-F vardiyaları cuma günleri başlatılacak.
2. Diğer vardiyalar cumartesi günleri başlayacak.
3. A vardiyası için ilk hafta 4-12, ikinci hafta 12-8 olacak ve 3. ve 4. haftalarda listede yer almayacak.

Birazdan uygun VBA kodunu hazırlayarak bunu dosyanıza uygulayabilmenizi sağlayacağım.
Aşağıda dosyanızdaki isteğinizi yerine getirecek bir VBA makrosu yer alıyor. Bu makro, belirttiğiniz kurallara göre vardiya dağılımını ayarlayacak.

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
   
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
   
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
   
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
   
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
       
        ' Vardiyaları belirle
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case "Cumartesi"
                ' Cumartesi günleri diğer vardiyalar
                Select Case haftaSayaci
                    Case 1
                        ws.Cells(satir, 2).Value = "B"
                        ws.Cells(satir, 3).Value = "A"
                    Case 2
                        ws.Cells(satir, 2).Value = "A"
                        ws.Cells(satir, 3).Value = "B"
                    Case 3
                        ws.Cells(satir, 2).Value = "C"
                        ws.Cells(satir, 3).Value = "D"
                    Case 4
                        ws.Cells(satir, 2).Value = "D"
                        ws.Cells(satir, 3).Value = "C"
                End Select
                haftaSayaci = haftaSayaci + 1
                If haftaSayaci > 4 Then haftaSayaci = 1 ' 4 haftalık döngü
            Case Else
                ' Diğer günler için boş bırak
                ws.Cells(satir, 2).Value = ""
                ws.Cells(satir, 3).Value = ""
        End Select
       
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
End Sub

Açıklama:

• E-F vardiyaları cuma günleri başlıyor: Cuma günlerinde "E" ve "F" vardiyaları otomatik olarak atanıyor.
• Diğer vardiyalar cumartesi başlıyor: Cumartesi günlerinde belirtilen haftalara göre B-A, A-B, C-D, D-C vardiya döngüsü çalışıyor.
• Her gün için 2 satır kullanılıyor: Hücre birleştirildiği için her iki satırda bir dolduruluyor.

Bu makroyu çalıştırarak dosyanızdaki vardiya düzenini otomatik hale getirebilirsiniz.

Hocam elinize sağlık vardiyaları sıralıyor fakat her gün için vardiya adını yazmıyor sadece cuma günleri E ile F vardiyalarını diğer vardiyaları ise cumartesi günlerine yazıyor diğer günleri de yazdırır isek isteğim yerine gelecek ibşallah.

 

[tugkan]

Anladım, her gün için vardiya adlarını yazdıracak şekilde makroyu güncelleyeceğim. Şimdi vardiya adları tüm günler için yazdırılacak.

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
    
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
    
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
    
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
        
        ' Vardiyaları belirle
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case "Cumartesi"
                ' Cumartesi günleri diğer vardiyalar
                Select Case haftaSayaci
                    Case 1
                        ws.Cells(satir, 2).Value = "B"
                        ws.Cells(satir, 3).Value = "A"
                    Case 2
                        ws.Cells(satir, 2).Value = "A"
                        ws.Cells(satir, 3).Value = "B"
                    Case 3
                        ws.Cells(satir, 2).Value = "C"
                        ws.Cells(satir, 3).Value = "D"
                    Case 4
                        ws.Cells(satir, 2).Value = "D"
                        ws.Cells(satir, 3).Value = "C"
                End Select
                haftaSayaci = haftaSayaci + 1
                If haftaSayaci > 4 Then haftaSayaci = 1 ' 4 haftalık döngü
            Case "Pazar", "Pazartesi", "Salı", "Çarşamba", "Perşembe"
                ' Haftanın diğer günleri için B-A ve C-D vardiyaları
                If haftaSayaci Mod 2 = 1 Then
                    ws.Cells(satir, 2).Value = "B"
                    ws.Cells(satir, 3).Value = "A"
                Else
                    ws.Cells(satir, 2).Value = "C"
                    ws.Cells(satir, 3).Value = "D"
                End If
        End Select
        
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
End Sub

Açıklama:

• Cuma günlerinde: E ve F vardiyaları yazdırılıyor.
• Cumartesi günlerinde: Hafta sayacına göre B-A, A-B, C-D, D-C vardiyaları yazdırılıyor.
• Diğer günlerde (Pazar - Perşembe): Vardiya düzenine göre B-A ve C-D yazdırılıyor.

Bu makroyu çalıştırdığınızda her gün için uygun vardiya adları yazdırılacaktır.

 

[yanginci34]

Anladım, her gün için vardiya adlarını yazdıracak şekilde makroyu güncelleyeceğim. Şimdi vardiya adları tüm günler için yazdırılacak.

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
   
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
   
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
   
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
   
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
       
        ' Vardiyaları belirle
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case "Cumartesi"
                ' Cumartesi günleri diğer vardiyalar
                Select Case haftaSayaci
                    Case 1
                        ws.Cells(satir, 2).Value = "B"
                        ws.Cells(satir, 3).Value = "A"
                    Case 2
                        ws.Cells(satir, 2).Value = "A"
                        ws.Cells(satir, 3).Value = "B"
                    Case 3
                        ws.Cells(satir, 2).Value = "C"
                        ws.Cells(satir, 3).Value = "D"
                    Case 4
                        ws.Cells(satir, 2).Value = "D"
                        ws.Cells(satir, 3).Value = "C"
                End Select
                haftaSayaci = haftaSayaci + 1
                If haftaSayaci > 4 Then haftaSayaci = 1 ' 4 haftalık döngü
            Case "Pazar", "Pazartesi", "Salı", "Çarşamba", "Perşembe"
                ' Haftanın diğer günleri için B-A ve C-D vardiyaları
                If haftaSayaci Mod 2 = 1 Then
                    ws.Cells(satir, 2).Value = "B"
                    ws.Cells(satir, 3).Value = "A"
                Else
                    ws.Cells(satir, 2).Value = "C"
                    ws.Cells(satir, 3).Value = "D"
                End If
        End Select
       
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
End Sub

Açıklama:

• Cuma günlerinde: E ve F vardiyaları yazdırılıyor.
• Cumartesi günlerinde: Hafta sayacına göre B-A, A-B, C-D, D-C vardiyaları yazdırılıyor.
• Diğer günlerde (Pazar - Perşembe): Vardiya düzenine göre B-A ve C-D yazdırılıyor.

Bu makroyu çalıştırdığınızda her gün için uygun vardiya adları yazdırılacaktır.

Çok teşekkür ederim hocam ufak bir sorun var ; Örneğin ayın ilk günü çarşambaya geldi o hafta cumaya kadar aynı vardiyayı yazsın ve ilk pazar günü diğer vardiya yazsın yani sizin kodunuza göre illa 6 günü tamamlıyor buda hafta ortasında vardiyayı değiştiriyor.

 

[tugkan]

Anladım, haftanın ilk günü olan pazartesiden başlayarak cuma gününe kadar aynı vardiyayı yazmak, ardından pazar günü yeni vardiyaya geçmek istiyorsunuz. Bu durumda, vardiya değişimini hafta ortasında değil, haftanın başlangıcında ve pazar günü olacak şekilde düzenlememiz gerekiyor.

Aşağıdaki VBA kodu, haftanın ilk günü (pazartesi) başlarken aynı vardiyanızı cuma gününe kadar sabit tutar ve pazar günü vardiyayı değiştirir.

Güncellenmiş VBA Makrosu

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    Dim mevcutVardiya(1 To 2) As String
    
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
    
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
    
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
    
    ' İlk haftanın vardiyasını başlat
    mevcutVardiya(1) = "B"
    mevcutVardiya(2) = "A"
    
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
        
        ' Her hafta pazar günü vardiya değiştir
        If gunAdi = "Pazar" Then
            haftaSayaci = haftaSayaci + 1
            Select Case haftaSayaci
                Case 1
                    mevcutVardiya(1) = "B"
                    mevcutVardiya(2) = "A"
                Case 2
                    mevcutVardiya(1) = "A"
                    mevcutVardiya(2) = "B"
                Case 3
                    mevcutVardiya(1) = "C"
                    mevcutVardiya(2) = "D"
                Case 4
                    mevcutVardiya(1) = "D"
                    mevcutVardiya(2) = "C"
                Case 5
                    mevcutVardiya(1) = "E"
                    mevcutVardiya(2) = "F"
                    haftaSayaci = 0 ' Yeni döngüye başla
            End Select
        End If
        
        ' Günlere göre vardiyayı yerleştir
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case Else
                ' Diğer günler için mevcut haftanın vardiyasını yaz
                ws.Cells(satir, 2).Value = mevcutVardiya(1)
                ws.Cells(satir, 3).Value = mevcutVardiya(2)
        End Select
        
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
End Sub

Açıklama:

1. Haftanın ilk günü (pazartesi) başlar ve cuma gününe kadar aynı vardiyayı korur.
2. Pazar günü vardiya değişir: İlk hafta B-A, ikinci hafta A-B, üçüncü hafta C-D, dördüncü hafta D-C olarak devam eder.
3. Cuma günleri E-F vardiyaları yazdırılır.
4. Her hafta pazar günü vardiya değiştirilir ve döngü tekrar başa döner.

Bu makro, hafta ortasında vardiyayı değiştirmeden, pazar gününden itibaren vardiyayı değiştirecektir. Deneyip, sonucu kontrol edebilirsiniz.

 

[yanginci34]

Anladım, haftanın ilk günü olan pazartesiden başlayarak cuma gününe kadar aynı vardiyayı yazmak, ardından pazar günü yeni vardiyaya geçmek istiyorsunuz. Bu durumda, vardiya değişimini hafta ortasında değil, haftanın başlangıcında ve pazar günü olacak şekilde düzenlememiz gerekiyor.

Aşağıdaki VBA kodu, haftanın ilk günü (pazartesi) başlarken aynı vardiyanızı cuma gününe kadar sabit tutar ve pazar günü vardiyayı değiştirir.

Güncellenmiş VBA Makrosu

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    Dim mevcutVardiya(1 To 2) As String
   
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
   
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
   
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
   
    ' İlk haftanın vardiyasını başlat
    mevcutVardiya(1) = "B"
    mevcutVardiya(2) = "A"
   
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
       
        ' Her hafta pazar günü vardiya değiştir
        If gunAdi = "Pazar" Then
            haftaSayaci = haftaSayaci + 1
            Select Case haftaSayaci
                Case 1
                    mevcutVardiya(1) = "B"
                    mevcutVardiya(2) = "A"
                Case 2
                    mevcutVardiya(1) = "A"
                    mevcutVardiya(2) = "B"
                Case 3
                    mevcutVardiya(1) = "C"
                    mevcutVardiya(2) = "D"
                Case 4
                    mevcutVardiya(1) = "D"
                    mevcutVardiya(2) = "C"
                Case 5
                    mevcutVardiya(1) = "E"
                    mevcutVardiya(2) = "F"
                    haftaSayaci = 0 ' Yeni döngüye başla
            End Select
        End If
       
        ' Günlere göre vardiyayı yerleştir
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case Else
                ' Diğer günler için mevcut haftanın vardiyasını yaz
                ws.Cells(satir, 2).Value = mevcutVardiya(1)
                ws.Cells(satir, 3).Value = mevcutVardiya(2)
        End Select
       
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
End Sub

Açıklama:

1. Haftanın ilk günü (pazartesi) başlar ve cuma gününe kadar aynı vardiyayı korur.
2. Pazar günü vardiya değişir: İlk hafta B-A, ikinci hafta A-B, üçüncü hafta C-D, dördüncü hafta D-C olarak devam eder.
3. Cuma günleri E-F vardiyaları yazdırılır.
4. Her hafta pazar günü vardiya değiştirilir ve döngü tekrar başa döner.

Bu makro, hafta ortasında vardiyayı değiştirmeden, pazar gününden itibaren vardiyayı değiştirecektir. Deneyip, sonucu kontrol edebilirsiniz.

Hocam elinize sağlık süpersiniz tam istediğim gibi oldu ancak mümkünse bir şey daha isteyeceğim örneğin ekim ayı bitti kasım ayını ayarlar iken ekim ayının devamı olarak ayarlayabilirmiyiz? Tekrar teşekkür ederim hakkınızı helal edin.

 

[tugkan]

Ekim ayı sona erdiğinde Kasım ayının ayarlarını yaparken, Ekim ayındaki vardiya düzenini devam ettirecek şekilde ayarlayabiliriz. Bu durumda, Kasım ayının ilk gününden itibaren Ekim ayındaki son vardiya düzenini kullanacağız.

Aşağıda, bu isteği karşılayacak güncellenmiş VBA makrosu yer alıyor:

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    Dim mevcutVardiya(1 To 2) As String
    Dim ay As Integer
    
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
    
    ' Ekim ayı bitiminde Kasım ayı ayarları
    ay = Month(ws.Cells(5, 1).Value) ' Başlangıç ayı
    If ay = 10 Then
        ' Ekim ayı sona erdi
        mevcutVardiya(1) = ws.Cells(5, 2).Value ' Ekim ayındaki son vardiyayı al
        mevcutVardiya(2) = ws.Cells(5, 3).Value
    Else
        ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
        baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
        bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
        satir = 5 ' 6. satırdan başla
        haftaSayaci = 1
        
        ' İlk haftanın vardiyasını başlat
        mevcutVardiya(1) = "B"
        mevcutVardiya(2) = "A"
        
        For i = baslangicTarihi To bitisTarihi
            gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
            
            ' Her hafta pazar günü vardiya değiştir
            If gunAdi = "Pazar" Then
                haftaSayaci = haftaSayaci + 1
                Select Case haftaSayaci
                    Case 1
                        mevcutVardiya(1) = "B"
                        mevcutVardiya(2) = "A"
                    Case 2
                        mevcutVardiya(1) = "A"
                        mevcutVardiya(2) = "B"
                    Case 3
                        mevcutVardiya(1) = "C"
                        mevcutVardiya(2) = "D"
                    Case 4
                        mevcutVardiya(1) = "D"
                        mevcutVardiya(2) = "C"
                    Case 5
                        mevcutVardiya(1) = "E"
                        mevcutVardiya(2) = "F"
                        haftaSayaci = 0 ' Yeni döngüye başla
                End Select
            End If
            
            ' Günlere göre vardiyayı yerleştir
            Select Case gunAdi
                Case "Cuma"
                    ' Cuma günleri E-F vardiyaları
                    ws.Cells(satir, 2).Value = "E"
                    ws.Cells(satir, 3).Value = "F"
                Case Else
                    ' Diğer günler için mevcut haftanın vardiyasını yaz
                    ws.Cells(satir, 2).Value = mevcutVardiya(1)
                    ws.Cells(satir, 3).Value = mevcutVardiya(2)
            End Select
            
            ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
            satir = satir + 2
        Next i
    End If
End Sub

Açıklama:

1. Ekim ayı sona erdiğinde, Ekim ayındaki son vardiya bilgilerini (A ve B) Kasım ayının başlangıcında kullanıyor.
2. Kasım ayının ilk gününden itibaren Ekim ayındaki vardiya düzenini devam ettiriyor.
3. Eğer Kasım ayıysa, standart vardiya döngüsünü başlatıyor.

Bu makro, Ekim ayının son gününde çalıştırıldığında, Kasım ayının başlangıcında Ekim ayındaki vardiyaları devam ettirecektir. Deneyip sonucu kontrol edebilirsiniz.

 

[yanginci34]

Hocam Ekim ayını örnek verdim yani her ayın sınunda bir sonraki ayı ayarlarken biten ayın devamını getirmesi gerekir eğer mümkünse

 

[tugkan]

Anladım, her ayın sonunda bir sonraki ayı ayarlarken, biten ayın vardiya düzeninin devam etmesini sağlayacak şekilde makroyu güncelleyebiliriz. Bu şekilde, her ayın son günü vardiya düzenini alacak ve bir sonraki ayın ilk gününden itibaren o vardiyayı devam ettirecek.

Güncellenmiş VBA Makrosu
Aşağıdaki kod, bu isteği yerine getirecek şekilde güncellendi:

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    Dim mevcutVardiya(1 To 2) As String
    
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
    
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
    
    ' Vardiya bilgilerini al
    mevcutVardiya(1) = ws.Cells(5, 2).Value
    mevcutVardiya(2) = ws.Cells(5, 3).Value
    
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
    
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
        
        ' Haftanın gününe göre vardiya yerleştir
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case Else
                ' Diğer günler için mevcut haftanın vardiyasını yaz
                ws.Cells(satir, 2).Value = mevcutVardiya(1)
                ws.Cells(satir, 3).Value = mevcutVardiya(2)
        End Select
        
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
    
    ' Yeni ayın başında mevcut vardiya bilgilerini güncelle
    Dim yeniAyBaslangici As Date
    yeniAyBaslangici = WorksheetFunction.EoMonth(baslangicTarihi, 0) + 1 ' Yeni ayın ilk günü

    ' Yeni ayın vardiya bilgilerini ayarlama
    ws.Cells(satir, 1).Value = yeniAyBaslangici ' Yeni ayın ilk günü
    ws.Cells(satir, 2).Value = mevcutVardiya(1)
    ws.Cells(satir, 3).Value = mevcutVardiya(2)
End Sub

Açıklama:

1. Mevcut vardiya bilgileri: Ayın sonunda vardiya bilgileri alınır ve yeni ayın başında devam ettirilir.
2. Yeni ayın başlangıç tarihi: Ayın bitiminde (son günü) bir sonraki ayın ilk gününü belirler.
3. Yeni ayın vardiya bilgileri: Yeni ayın ilk gününde önceki ayın vardiyaları yazdırılır.

Bu kod, her ay sonunda çalıştırıldığında, bir sonraki ayın başlangıcında önceki ayın vardiya düzenini devam ettirir.

 

[yanginci34]

Hocam

Anladım, her ayın sonunda bir sonraki ayı ayarlarken, biten ayın vardiya düzeninin devam etmesini sağlayacak şekilde makroyu güncelleyebiliriz. Bu şekilde, her ayın son günü vardiya düzenini alacak ve bir sonraki ayın ilk gününden itibaren o vardiyayı devam ettirecek.

Güncellenmiş VBA Makrosu
Aşağıdaki kod, bu isteği yerine getirecek şekilde güncellendi:

Sub VardiyaDuzeniGuncelle()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim bitisTarihi As Date
    Dim i As Long
    Dim satir As Long
    Dim haftaSayaci As Integer
    Dim gunAdi As String
    Dim mevcutVardiya(1 To 2) As String
  
    Set ws = ThisWorkbook.Sheets("VARDİYA") ' Sayfa adı
  
    ' Tarihlerin olduğu sütundaki başlangıç ve bitiş tarihlerini belirle
    baslangicTarihi = ws.Cells(5, 1).Value ' 6. satırdaki tarih
    bitisTarihi = WorksheetFunction.EoMonth(baslangicTarihi, 0) ' Ayın son günü
  
    ' Vardiya bilgilerini al
    mevcutVardiya(1) = ws.Cells(5, 2).Value
    mevcutVardiya(2) = ws.Cells(5, 3).Value
  
    satir = 5 ' 6. satırdan başla
    haftaSayaci = 1
  
    For i = baslangicTarihi To bitisTarihi
        gunAdi = WeekdayName(Weekday(i, vbMonday), False, 2)
      
        ' Haftanın gününe göre vardiya yerleştir
        Select Case gunAdi
            Case "Cuma"
                ' Cuma günleri E-F vardiyaları
                ws.Cells(satir, 2).Value = "E"
                ws.Cells(satir, 3).Value = "F"
            Case Else
                ' Diğer günler için mevcut haftanın vardiyasını yaz
                ws.Cells(satir, 2).Value = mevcutVardiya(1)
                ws.Cells(satir, 3).Value = mevcutVardiya(2)
        End Select
      
        ' Her gün için 2 satır atlanmış hücreler olduğundan bir satır atla
        satir = satir + 2
    Next i
  
    ' Yeni ayın başında mevcut vardiya bilgilerini güncelle
    Dim yeniAyBaslangici As Date
    yeniAyBaslangici = WorksheetFunction.EoMonth(baslangicTarihi, 0) + 1 ' Yeni ayın ilk günü

    ' Yeni ayın vardiya bilgilerini ayarlama
    ws.Cells(satir, 1).Value = yeniAyBaslangici ' Yeni ayın ilk günü
    ws.Cells(satir, 2).Value = mevcutVardiya(1)
    ws.Cells(satir, 3).Value = mevcutVardiya(2)
End Sub

Açıklama:

1. Mevcut vardiya bilgileri: Ayın sonunda vardiya bilgileri alınır ve yeni ayın başında devam ettirilir.
2. Yeni ayın başlangıç tarihi: Ayın bitiminde (son günü) bir sonraki ayın ilk gününü belirler.
3. Yeni ayın vardiya bilgileri: Yeni ayın ilk gününde önceki ayın vardiyaları yazdırılır.

Bu kod, her ay sonunda çalıştırıldığında, bir sonraki ayın başlangıcında önceki ayın vardiya düzenini devam ettirir.

Hocam iyi akşamlar bu kod ile şöyle hata alıyorum bir önceki vardiya hangi grup ile biliyorsa hazırlamış olduğum vardiya listesinin her gününü onun ile dolduruyor. Yani enson A-B vardiyası ise her gün onlarla doluyor. Hocam sizi çok yoruyorum ama son olarak şöyle örnek vereyim anlaşılır olması açısından B-A, A-B, C-D, D-C periyodu ile devam etmeli örneğin biten ay A-B ile bittiyse başlangıç ilk cumartesiye kadar A-B ile devam etsin ardından periyot sırası olan C-D ve böyle sürsün.

 

[yanginci34]

Arkadaşlar Bir ustam bu sorunumu aşağıdaki kod ile çözdü lazım olan arkadaşlar için kodu paylaşıyorum. Tugkan Hocam hakkınızı elal edin.

Sub a()
If IsDate(Range("G3")) = False Then
MsgBox "G3 hücresinde sadece ayın ilk gününe ait tarih olmalıdır."
Range("G3").Select
Exit Sub
End If
  Range("A6:C69").Select
    Selection.ClearContents
   Range("G3").Value = Application.Text(Range("G3"), "dd.mm.yyyy") & "-" & Application.Text(Application.EoMonth(Range("G3"), 0), "dd.mm.yyyy")
yaz = 6

grb1 = Split("A#B", "#")
grb2 = Split("C#D", "#")
grb3 = Split("E#F", "#")

bak1 = CDate("1.1.2024")
bak2 = CDate("31.12.2029")
kıs1 = CDate(Split(Range("G3"), "-")(0))
kıs2 = CDate(Split(Range("G3"), "-")(1))
For i = bak1 To bak2
If i >= kıs1 And i <= kıs2 Then
Cells(yaz, 1).Value = i
If i Mod 7 = 0 And i Mod 2 = 0 Then
Cells(yaz, 2).Value = grb3(0)
Cells(yaz, 3).Value = grb3(1)
End If
If i Mod 7 = 0 And i Mod 2 = 1 Then
Cells(yaz, 2).Value = grb3(1)
Cells(yaz, 3).Value = grb3(0)
End If
If i Mod 7 <> 0 And i Mod 28 >= 7 And i Mod 28 <= 14 Then
Cells(yaz, 2).Value = grb2(1)
Cells(yaz, 3).Value = grb2(0)
End If
If i Mod 7 <> 0 And i Mod 28 >= 15 And i Mod 28 <= 21 Then
Cells(yaz, 2).Value = grb2(0)
Cells(yaz, 3).Value = grb2(1)
End If
If i Mod 7 <> 0 And i Mod 28 >= 0 And i Mod 28 <= 6 Then
Cells(yaz, 2).Value = grb1(0)
Cells(yaz, 3).Value = grb1(1)
End If
If i Mod 7 <> 0 And i Mod 28 >= 22 And i Mod 24 <= 28 Then
Cells(yaz, 2).Value = grb1(1)
Cells(yaz, 3).Value = grb1(0)
End If
If bak1 = bak2 Then Exit For
bak1 = bak1 + 1
yaz = yaz + 2
End If
Next
End Sub