Hakedilen Pazar Sayısı - ByChilavert - 30/06/2020
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
Re: Hakedilen Pazar Sayısı - berduş - 08/07/2020
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
RE: Hakedilen Pazar Sayısı - ByChilavert - 10/07/2020
Teşekkür Ederim.
RE: Hakedilen Pazar Sayısı - berduş - 10/07/2020
denedikten sonra lütfen geribildirimde bulunmayı unutmayın,
iyi çalışmalar.
RE: Hakedilen Pazar Sayısı - ByChilavert - 10/07/2020
Sorunum Çözüldü. Teşekkür Ederim.
|