Skip to main content

AccessTr.neT


Hakedilen Pazar Sayısı

Hakedilen Pazar Sayısı

Çözüldü #1
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
Son Düzenleme: 30/06/2020, 21:20, Düzenleyen: ByChilavert. (Sebep: Dosya)
Cevapla
#2
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
Cevapla
#3
Teşekkür Ederim.
Cevapla
#4
denedikten sonra lütfen geribildirimde bulunmayı unutmayın,
iyi çalışmalar.
Cevapla
#5
Sorunum Çözüldü. Teşekkür Ederim.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task