AccessTr.neT

Merhaba

Çalıştığım şirkette kullanmakta olduğum puantajda bir kaç işlem yapmak istiyorum. Personel ay içerisinde pazar günü (KÇ - Kısa Çalışma, ÜC - Ücretsiz İzin, O - Puantaj Kaydı, R - Rapor) varsa sayfanın sonundaki (HAKETTİĞİ PAZAR) sayısından düşerek yazmasını istiyorum. 
Örnek ay içerisinde 5 pazar var personel 2 pazarda (KÇ, ÜC, O, R) varsa Hakettiği pazar alanında 3 yazmasını istiyorum. Eğer yoksa 5 yazmasını istiyorum. Bu konuda nasıl bir işlem yapmam gerekiyor yardımcı olabilir misiniz?



İndir

aşağıdaki kod PUANTAJ sayfasının Worksheet_Change olayına ait
dielerim işinize yarar
Not:xlsx dosyalarına makro kaydedemezsiniz o nedenle dosyanızı xlsm olarak kaydetmelisiniz

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xStun As Range

Dim ilkPzr, SonPzr As Byte

Dim xSatir, ySatir, SonSatir As Long

Dim Trh, Trh2 As Date



Set xStun = Range("AE:BI")

Trh = Range("AE3").Value

Trh2 = DateAdd("m", 1, Trh)

ilkPzr = Day(Trh - Weekday(Trh, 2) + 7) - 1

SonPzr = Day(Trh2 - Weekday(Trh2, 2)) - 1

xSatir = Target.Row 'range().Offset (RowOffset, ColumnOffset)



If Not Application.Intersect(xStun, Range(Target.Address)) Is Nothing Then

    If xSatir > 5 And (xSatir Mod 2 = 1) Then 'sadece 5den büyük tek satırlardaki değişiklikleri hesaba katar

    Range("BQ" & xSatir - 1) = 0

        For x = ilkPzr To SonPzr Step 7

            If InStr(1, "KÇ, ÜC, O, R", Range("AE" & xSatir).Offset(, x), 1) < 1 Then

                Range("BQ" & xSatir - 1) = Range("BQ" & xSatir - 1) + 1

            End If

        Next x

    ElseIf Target.Address = "$AE$3" Then 'tarih değiştiğinde tümü üzerinden işlem yapmak için

    

    xSatir = 7

    SonSatir = ActiveSheet.Cells(ActiveSheet.Rows.Count, "AE").End(xlUp).Row

    For ySatir = xSatir To SonSatir Step 2

        Range("BQ" & ySatir - 1) = 0

            For x = ilkPzr To SonPzr Step 7

                If InStr(1, "KÇ, ÜC, O, R", Range("AE" & ySatir).Offset(, x), 1) < 1 Then

                    Range("BQ" & ySatir - 1) = Range("BQ" & ySatir - 1) + 1

                End If

            Next x

    Next ySatir

    End If

End If



End Sub

yada daha sadesi

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xStun As Range

Dim ilkPzr, SonPzr As Byte

Dim xSatir, ySatir, SonSatir As Long

Dim Trh, Trh2 As Date



Set xStun = Range("AE:BI")

Trh = Range("AE3").Value

Trh2 = DateAdd("m", 1, Trh)

ilkPzr = Day(Trh - Weekday(Trh, 2) + 7) - 1

SonPzr = Day(Trh2 - Weekday(Trh2, 2)) - 1

xSatir = Target.Row 'range().Offset (RowOffset, ColumnOffset)



If Not Application.Intersect(xStun, Range(Target.Address)) Is Nothing Then

    If xSatir > 5 And (xSatir Mod 2 = 1) Then 'sadece 5den büyük tek satırlardaki değişiklikleri hesaba katar

        SonSatir = xSatir

    ElseIf Target.Address = "$AE$3" Then 'tarih değiştiğinde tümü üzerinden işlem yapmak için

        xSatir = 7

        SonSatir = ActiveSheet.Cells(ActiveSheet.Rows.Count, "AE").End(xlUp).Row

     End If



    For ySatir = xSatir To SonSatir Step 2

        Range("BQ" & ySatir - 1) = 0

            For x = ilkPzr To SonPzr Step 7

                If InStr(1, "KÇ, ÜC, O, R", Range("AE" & ySatir).Offset(, x), 1) < 1 Then

                    Range("BQ" & ySatir - 1) = Range("BQ" & ySatir - 1) + 1

                End If

            Next x

    Next ySatir

End If



End Sub

Teşekkür Ederim.

denedikten sonra lütfen geribildirimde bulunmayı unutmayın,
iyi çalışmalar.

Sorunum Çözüldü. Teşekkür Ederim.