Tarih Belirleme

[ckarabacak]

iyi Akşamlar Arkadaşlar

Ekli dosyada yapmak istediğim dosyada da detaylı olmak üzere anlatmaya çalıştığım gibi

C sütunundaki tarihe makro ile önce 1 yıl ekleyip sonrasında E sütunundaki günü toplayarak F sütunundaki tarihi bulmak istiyorum.

Yardımlarınız için şimdiden teşekkür ederim.

 

[vardar07]

Sayfa1 kod bölümüne:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("D3:D500")) Is Nothing Then Exit Sub
Call Module1.hakediş_tarihibelirleme
End Sub

Modül1 içine:

Sub hakediş_tarihibelirleme()
With Sheets("Sayfa1")
x = WorksheetFunction.CountA(Range("C:C"))
.Range("E3:E" & x).ClearContents
For i = 3 To x
ay = DateSerial(Year(.Cells(i, "C")) + 1, Month(.Cells(i, "C")), Day(.Cells(i, "C")))
If WorksheetFunction.CountIf(.Range("B1:B" & i), .Cells(i, "B")) = 1 Then
mv = 0
End If
If WorksheetFunction.CountIf(.Range("B1:B" & i), .Cells(i, "B")) >= 1 Then
mv = mv + .Cells(i, "D")
.Cells(i, "E") = mv + ay
End If
Next
End With
End Sub

Ekleyin ve sayfa1 den D sütununu siliniz. D sütununu sildikten sonra yeni oluşacak D sütununa veri girdikçe otomatik çalışır. Deneyiniz.

 

[ckarabacak]

Vardar07 Merhaba

OLUŞTUR Butonunu Kullanmadan C sütunundaki tarih değiştiğinde E sütunundaki tarihin değişmesini de sağlayabilir miyiz.

 

[vardar07]

Sayfa1 kod bölümündeki kodu aşağıdaki ile değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C3:C500,D3:D500")) Is Nothing Then Exit Sub
Call Module1.hakediş_tarihibelirleme
End Sub

 

[ckarabacak]

Vardar07 merhaba

yardımınız için çok teşekkür ederim.

 

[vardar07]

Rica ederim.

 

[ckarabacak]

Tarih belirleme

Vardar07 Tekrar Merhaba

Her seferinde tabloda bir eksiklikler olduğunu veya olması gerekenin farklı olduğunu düşünerek

ekli tabloda ;

* KİŞİLERE GÖRE "C" SÜTUNUNDAKİ TARİHLERİN "E" SÜTUNUNA "F" SÜTUNUNDA GÖRÜLDÜĞÜ GİBİ YIL ARTIŞI OLMASINI İSTİYORUM.

Bir hamle daha rica edeceğim sizden

 

[vardar07]

Buyurun. :???:

Sub hakediş_tarihibelirleme()
With Sheets("Sayfa1")
x = WorksheetFunction.CountA(Range("C:C"))
.Range("E3:E" & x).ClearContents
For i = 3 To x
If WorksheetFunction.CountIf(.Range("B1:B" & i), .Cells(i, "B")) = 1 Then
mv = 0
a = 1
End If
If WorksheetFunction.CountIf(.Range("B1:B" & i), .Cells(i, "B")) >= 1 Then
ay = DateSerial(Year(.Cells(i, "C")) + a, Month(.Cells(i, "C")), Day(.Cells(i, "C")))
mv = mv + .Cells(i, "D")
.Cells(i, "E") = mv + ay
a = a + 1
End If
Next
End With
End Sub

 

[ckarabacak]

Çok Teşekkür ederim Vardar07

 

[ckarabacak]

yıllık izinlerin bölünmesi halinde

Merhaba vardar07

son göndermiş olduğunuz makro ile istenen bilgi alındı ancak;

ekli dosyada görüldüğü ve açıklamaya çalıştığım gibi,

kullanılan yıllık izinlerin bölünmesi halinde sorun çıktı (yıllık izin gün sütununda görülen günler) "o" sütunu

"t" sütununda görülen tarihlerin "l" sütununda oluşması mümkünmüdür.

 

[vardar07]

Deneyiniz.

Sub hakediş_tarihibelirleme()
With Sheets("İZİN TAKİP LİSTESİ")
x = WorksheetFunction.CountA(Range("I:I"))
.Range("L3:L" & x).ClearContents
For i = 3 To x
a = .Cells(i, "M")
If WorksheetFunction.CountIf(.Range("F1:F" & i), .Cells(i, "F")) = 1 Then
mv = 0
End If
If WorksheetFunction.CountIf(.Range("F1:F" & i), .Cells(i, "F")) >= 1 Then
ay = DateSerial(Year(.Cells(i, "I")) + a, Month(.Cells(i, "I")), Day(.Cells(i, "I")))
mv = mv + .Cells(i, "K")
.Cells(i, "L") = mv + ay
End If
Next
End With
End Sub

 

[ckarabacak]

Merhaba

"M" sütunundaki sayı değişikliğinde yıllık izin hakkediş yılı değişmiyor. Makro çalıştır yapıyorum. sayı değişiminde otomatik yıl değişimi olabilir değilmi

 

[vardar07]

Kırmızı ile belirtilen yerde değişiklik yaparak sonucu görebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("[B][COLOR="Red"]I3:I500,K3:K500,M3:M500[/COLOR][/B]")) Is Nothing Then Exit Sub
Call Module3.hakediş_tarihibelirleme
End Sub

 

[ckarabacak]

Merhaba vardar07

Yardımlarınız için çok teşekkür ederim. Elinize, Aklınıza Sağlık.

 

[vardar07]

Rica ederim. Kolay gelsin.