Soru Pazartesi-Salı-Çarşamba ve Çarşamba-Perşembe-Cuma çizelge hk

[balanar]

Merhaba,

StajyerListesi adlı sayfamızda kişilerin kayıtları ve hangi gruba ait olduklarının belirlenmesi için * işareti var. Bu işaret değiştirilebilir sorun değil.
Buradaki seçeneklere göre kişi hangi gruptaysa onunla ilgili sayfaya bilgilerinin gelmesini istiyorum.

Birde StajyerListesi sayfasında SARI İŞARETLİ AY ve YIL tercihi var. Onu tercih ettiğimizde misal EYLÜL 2021 yaptık. İlgili ayın sadece Pazartesi-Salı-Çarşamba olan günleri Pazartesi-Salı-Çarşamba sayfasına, sadece Çarşamba-Perşembe-Cuma olanların Çarşamba-Perşembe-Cuma sayfasına aktarılmasını istiyorum. Tabiki ay ve yıl değiştiğinde otomatik değişmesi gerekiyor.. Ek dosyada doğru örnek olması gerekeni manuel girdim..

Hakkınızı helal edin yapamıyoruz sürekli sizlerden yardım bekliyoruz..

 

[Ömer]

Merhaba,

Deneyiniz.

Sub stajyer_listele()

    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim tarih As Date, songun As Date
    Dim sut1 As Byte, sut2 As Byte, i As Date, sat1 As Long, sat2 As Long, j As Long
    
    Set S1 = Sheets("StajyerListesi")
    Set S2 = Sheets("Pazartesi-Salı-Çarşamba")
    Set S3 = Sheets("Çarşamba-Perşembe-Cuma")
    
    tarih = "1." & S1.[F1] & "." & S1.[G1]
    songun = DateSerial(Year(tarih), Month(tarih) + 1, 0)
    
    Application.ScreenUpdating = False
    S2.Range("A6:C100000,D5:P5").ClearContents
    S3.Range("A6:C100000,D5:P5").ClearContents
    
    S2.[D2] = "1 " & Format(songun, "mmmm") & "-" & Format(songun, "dd mmmm yyyy") & " Arası Stajer Puan Cetveli"
    S3.[D2] = "1 " & Format(songun, "mmmm") & "-" & Format(songun, "dd mmmm yyyy") & " Arası Stajer Puan Cetveli"
    
    sut1 = 4: sut2 = 4
    For i = tarih To songun
        If Weekday(i, 2) < 4 Then
            S2.Cells(5, sut1) = i
            sut1 = sut1 + 1
        End If
        If Weekday(i, 2) > 3 And Weekday(i, 2) < 7 Then
            S3.Cells(5, sut2) = i
            sut2 = sut2 + 1
        End If
    Next i
    
    sat1 = 6: sat2 = 6
    For j = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        If S1.Cells(j, "C") = "*" Then
            S2.Cells(sat1, "A") = sat1 - 5
            S2.Cells(sat1, "B") = S1.Cells(j, "A")
            S2.Cells(sat1, "C") = S1.Cells(j, "B")
            sat1 = sat1 + 1
        End If
        If S1.Cells(j, "D") = "*" Then
            S3.Cells(sat2, "A") = sat2 - 5
            S3.Cells(sat2, "B") = S1.Cells(j, "A")
            S3.Cells(sat2, "C") = S1.Cells(j, "B")
            sat2 = sat2 + 1
        End If
    Next j
    
    Application.ScreenUpdating = True
    
End Sub

 

[balanar]

Ömer bey elinize sağlık,

Çarşamba-Perşembe-Cuma grubunda 2Eylül'den başlatıyor 1 Eylül'den alması gerekmiyormu eylül ayına göre

Birde mesela ay kısmını EKİM olarak değiştirip calıstıyıroum


tarih = "1." & S1.[F1] & "." & S1.[G1]

sarı işaretli hata cikariyor hocam

 

[Ömer]

Hatayı hallederiz de günler mükerrere düşmüyor mu. Ben dikkat etmemiştim.

Pazartesi-Salı-Çarşamba
Çarşamba-Perşembe-Cuma

Çarşamba günü 2 sayfada oluyor. Bu şekilde doğru mu? Bu kısım dikkatimden kaçmış.?

 

[Ömer]

İstediğiniz gibi.

Sub stajyer_listele()

    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim tarih As Date, songun As Date
    Dim sut1 As Byte, sut2 As Byte, i As Date, sat1 As Long, sat2 As Long, j As Long
    
    Set S1 = Sheets("StajyerListesi")
    Set S2 = Sheets("Pazartesi-Salı-Çarşamba")
    Set S3 = Sheets("Çarşamba-Perşembe-Cuma")

    tarih = "1." & LCase(Replace(Replace(S1.[F1], "I", "ı"), "İ", "i")) & "." & S1.[G1]
    songun = DateSerial(Year(tarih), Month(tarih) + 1, 0)
    
    Application.ScreenUpdating = False
    S2.Range("A6:C100000,D5:P5").ClearContents
    S3.Range("A6:C100000,D5:P5").ClearContents
    
    S2.[D2] = "1 " & Format(songun, "mmmm") & "-" & Format(songun, "dd mmmm yyyy") & " Arası Stajer Puan Cetveli"
    S3.[D2] = "1 " & Format(songun, "mmmm") & "-" & Format(songun, "dd mmmm yyyy") & " Arası Stajer Puan Cetveli"
    
    sut1 = 4: sut2 = 4
    For i = tarih To songun
        If Weekday(i, 2) < 4 Then
            S2.Cells(5, sut1) = i
            sut1 = sut1 + 1
        End If
        If Weekday(i, 2) > 2 And Weekday(i, 2) < 6 Then
            S3.Cells(5, sut2) = i
            sut2 = sut2 + 1
        End If
    Next i
    
    sat1 = 6: sat2 = 6
    For j = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        If S1.Cells(j, "C") = "*" Then
            S2.Cells(sat1, "A") = sat1 - 5
            S2.Cells(sat1, "B") = S1.Cells(j, "A")
            S2.Cells(sat1, "C") = S1.Cells(j, "B")
            sat1 = sat1 + 1
        End If
        If S1.Cells(j, "D") = "*" Then
            S3.Cells(sat2, "A") = sat2 - 5
            S3.Cells(sat2, "B") = S1.Cells(j, "A")
            S3.Cells(sat2, "C") = S1.Cells(j, "B")
            sat2 = sat2 + 1
        End If
    Next j
    
    Application.ScreenUpdating = True
    
End Sub

 

[balanar]

Hatayı hallederiz de günler mükerrere düşmüyor mu. Ben dikkat etmemiştim.

Pazartesi-Salı-Çarşamba
Çarşamba-Perşembe-Cuma

Çarşamba günü 2 sayfada oluyor. Bu şekilde doğru mu? Bu kısım dikkatimden kaçmış.?

Çarşamba her iki gruptada var hocam

 

[Ömer]

#5 numaraları mesajda hatayı da düzelterek son halini ekledim, dener misiniz.

 

[balanar]

Elinize sağlık çok teşekkür ederim Ömer bey