Bellı bır tarıhte maas eklemesı

[zevkotodizayn]

Selam arkadaslar

Firmamızıın personel cari hesap hareketlerini excelde tutuyoruz.
Örnek olarak personelimin 28.12.10 da maaş günü geliyor ve maaşının otomatik olarak cari hesabına işlenmesini istiyorum, hergün takipi zor oluyor.

Teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz. Aşağıdaki kodu Sayfa1 'in kod bölümüne uygulayın. Daha sonra sistem tarihinizi ayın 28'ine ayarlayın. Başka bir sayfayı seçtikten sonra tekrar Sayfa1'i tıkladığınızda kod otomatik çalışacaktır. Size bir uyarı mesajı ile maaş bilgisini eklemek istiyormusunuz diye soru gelecek. Evet dediğinizde maaş satırı otomatik eklenecektir.

Option Explicit
 
Private Sub Worksheet_Activate()
    Dim BUL As Range, ADRES As String, SAY As Byte
    
    If Date >= DateSerial(Year(Date), Month(Date), 28) And Date <= DateSerial(Year(Date), Month(Date) + 1, 0) Then
        Set BUL = Range("B:B").Find(DateSerial(Year(Date), Month(Date), 28))
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
        If InStr(1, BUL.Offset(0, 1), "MAAS") > 0 Then SAY = SAY + 1
        Set BUL = Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        If SAY = 0 Then
            If MsgBox("Maaş bilgisini otomatik eklemek ister misiniz?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then
                Range("B65536").End(3).Offset(1) = DateSerial(Year(Date), Month(Date), 28)
                Range("B65536").End(3).Offset(0, 1) = UCase(Replace(Replace(Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mmmm"), "ı", "I"), "i", "İ") & " MAASI")
                Range("B65536").End(3).Offset(0, 3) = 1000
                Range("B65536").End(3).Offset(0).Resize(1, 4).Interior.ColorIndex = 15
            End If
        End If
    End If
    
    If Day(Date) >= 1 And Day(Date) <= 15 Then
        Set BUL = Range("B:B").Find(DateSerial(Year(Date), Month(Date) - 1, 28))
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
        If InStr(1, BUL.Offset(0, 1), "MAAS") > 0 Then SAY = SAY + 1
        Set BUL = Range("B:B").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
        If SAY = 0 Then
            If MsgBox("Maaş bilgisini otomatik eklemek ister misiniz?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then
                Range("B65536").End(3).Offset(1) = DateSerial(Year(Date), Month(Date) - 1, 28)
                Range("B65536").End(3).Offset(0, 1) = UCase(Replace(Replace(Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mmmm"), "ı", "I"), "i", "İ") & " MAASI")
                Range("B65536").End(3).Offset(0, 3) = 1000
                Range("B65536").End(3).Offset(0).Resize(1, 4).Interior.ColorIndex = 15
            End If
        End If
    End If
End Sub

 

[zevkotodizayn]

Korhan Bey cevabiniz icin cok tesekkur ederim,
denedim calisitirdim
fakat eyer ayin calisma kitabini ayin28.de acmayip 29.da acarsam da beni uyarir mi?

 

[Korhan Ayhan]

Selamlar,

Kod bu haliyle istediğiniz şekilde uyarmaz.

 

[zevkotodizayn]

Selamlar,

Kod bu haliyle istediğiniz şekilde uyarmaz.

Nasil uyarir hale getirebilirim?
Tesekkurler....

 

[Korhan Ayhan]

Selamlar,

Hangi tarihler arası kontrol yapılacak?

 

[zevkotodizayn]

Selamlar,

Hangi tarihler arası kontrol yapılacak?

28 ile sonraki ayin 15.
alakaniz icin cok tesekkur ederim.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.