• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Belirli tarih aralığındaki kayıtları başka sayfaya aktarmak.

  • Konbuyu başlatan Konbuyu başlatan unur
  • Başlangıç tarihi Başlangıç tarihi
Necdet Bey; Yazacaklarım hem maaş hem emeklilik açısından da aynı)
-Yükseleceği derece kademe hesapla butonuna bastığımızda, tüm personelin 2014 yılında yükseleceği derece kademeleri hesaplamış olacağız.
-Aktar butonuna bastığımızda ise ilgili ayda (D1 ve E1) tarihleri arasında ilerlemiş olan personeli derece kademe sayfasına aktarmak (o ay derece kademesi olanları yayımlamak için) Aktar butonuna bastığımızda ayrıca bir ilerleme olmasını istemiyorum.
Teşekkürler.
 
Ben tüm kodlarda ilerleyecek diye yazmıştım, sadece aktarmak işi işin en kolay yönü. terfileri kaldırırız olur biter :) Pazartesi günü halledecem.
 
Necdet Bey;ben terfileri kaldırmak için şunları mı silsem bunları mı silsem diye çok uğraştım beceremedim.
Necdet Bey zamanında bir reklam vardı çok oluyoruz artık diye:)) Bende çok oldum ama Affınıza sığınarak;

Arşiv butonu yerine de bir buton eklesek ve şu an mevcut ilerlemiş derece kademeleri kopyalayıp, almakta olduğu aylığına yapıştırmak ve yükseleceği aylık bölümünü temizlemek( yani yeni yılda kullanmak üzere)
Aynı zamanda bunu yaparken yükseleceği tarihlerin yıl bölümünü bir yıl artırsın (örn:24.08.2014 terfi tarifini, 24.08.2015 yapsın)
Teşekkürler.
 
Son düzenleme:
Arşiv butonu yerine de bir buton eklesek ve şu an mevcut ilerlemiş derece kademeleri kopyalayıp, almakta olduğu aylığına yapıştırmak ve yükseleceği aylık bölümünü temizlemek( yani yeni yılda kullanmak üzere)
Aynı zamanda bunu yaparken yükseleceği tarihlerin yıl bölümünü bir yıl artırsın (örn:24.08.2014 terfi tarifini, 24.08.2015 yapsın)
Teşekkürler.

Merhaba,

Bu dedikleriniz hangi sayfada olacak? Biraz daha den konuşursanız yeni duruma göre kodları düzenleyim.
 
Necdet Bey; Emeklerinize sağlık, biliyorum çok zamanınızı aldım ama kusuruma bakmayın.

*Genel Liste sayfasında; yükseleceği derece kademe hesapla butonu normal görevini yapıyor proplem yok.
Yapılması gereken;
-Aktar butonu genel liste sayfasındaki bilgilerde herhangi bir değişiklik olmadan (D1 ve E1) tarihleri arasındaki kayıtları derece kademe sayfasına aktarması (Bu her ay derece kademesi ilerleyecek personel bilgilerini ilgili birime göndermek için kullanılacak)
Derece kademe sayfasındaki arşive aktar butonu iptal edilip, onun yerine;
Genel Liste sayfasına bir buton ekleyerek bu butona tıkladığımda;
-Genel Liste sayfasındaki hem maaş hem emekli keseneğinin yükseleceği aylığı bölümündeki derece kademeleri,almakta olduğu derece kademe bölümüne kopyalayarak,yükseleceği aylık bölümünü boşaltmış olacak ve yükseleceği tarihlerin yıl bölümünü bir yıl artıracak(şimdiki 25.07.2014 olan tarih 25.07.2015 olacak)

Böylelikle 2015 derece kademe ilerlemesi içinde listem hazır hale gelmiş olacak.

Umarım derdimi anlatabilmişimdir.

Teşekkürler.
 
Son düzenleme:
Merhaba,

Umarım doğru anlamışımdır. Kodları ve dosyayı inceleyiniz.

Aktarma Kodları :

Kod:
Private Sub CommandButton1_Click()
                                'AKTARMA İŞLEMİNİ YAPAR
                                'N. YEŞERTENER, ANKARA, 9 OCAK 2014
    Dim i   As Long, _
        j   As Long, _
        Adt As Integer, _
        Flg As Boolean, _
        Ayl As Boolean, _
        Eml As Boolean, _
        ShG As Worksheet, _
        ShD As Worksheet, _
        Tar As String, _
        c   As Range, _
        Sonuc
    Set ShG = Sheets("GENEL LİSTE 2014")
    Set ShD = Sheets("Derece Kademe")
    
    Tar = Format(CDbl(ShG.Range("D1")), "YYYY.MM.DD") & " - " & Format(CDbl(ShG.Range("E1")), "YYYY.MM.DD")
    
    Set c = ShD.Range("Q:Q").Find(Tar, LookIn:=xlValues)
    If Not c Is Nothing Then
        MsgBox Range("D1") & " - " & Range("E1") & " TARİHLİ TERFİLER DAHA ÖNCE AKTARILMIŞTIR...." & Chr(10) & Chr(10) & _
            "TEKRAR AKTARMAK İSTİYORSANIZ AKTARILAN BU VERİLERİ SİLDİKTEN SONRA TEKRAR DENEYİNİZ", vbCritical, "N. YEŞERTENER"
        Exit Sub
    End If
    
    j = ShD.Cells(Rows.Count, "A").End(3).Row
    If j < 5 Then j = 5
    ShD.Range("A5:P" & j).ClearContents
    j = 4
    
    For i = 5 To ShG.Cells(Rows.Count, "A").End(3).Row
    
        Flg = False
        Ayl = False
        Eml = False
        
        If (ShG.Cells(i, "K") >= ShG.Range("D1") And ShG.Cells(i, "K") <= ShG.Range("E1")) Then
            Flg = True
            Ayl = True
        End If
        
        If ShG.Cells(i, "P") >= ShG.Range("D1") And ShG.Cells(i, "P") <= ShG.Range("E1") Then
            Flg = True
            Eml = True
        End If
        
        If Flg = True Then
            j = j + 1
            Adt = Adt + 1
            ShD.Cells(j, "Q") = Tar
            ShG.Range("A" & i & ":P" & i).Copy ShD.Range("A" & j)
        End If
    Next i
    
    If Adt = 0 Then
        MsgBox "AKTARILACAK ŞARTA UYGUN VERİ BULUNMADI....", vbCritical
    Else
        MsgBox Adt & " Adet Veri Aktarılmıştır....", vbInformation
    End If
    
End Sub

Derece / Kademe Hesaplama Kodları

Kod:
Private Sub CommandButton2_Click()
                        'Yükseleceği DERECE / KADEME Hesaplar
                        'N. YEŞERTENER, ANKARA, 9 Ocak 2014
    Dim EH  As String
    Dim i   As Long
    Dim Son As Long
    Dim Sonuc
 
    EH = MsgBox("YÜKSELECEĞİ DERECE VE KADEME HESAPLANACAK, EMİN MİSİNİZ?", vbYesNo)
 
    If EH = vbNo Then
        MsgBox "VAZ GEÇTİNİZ....", vbCritical, "SORGULAMA..."
        Exit Sub
    End If
 
    Son = Cells(Rows.Count, "B").End(3).Row
    If Son < 5 Then
        MsgBox "Hesaplanacak Veriye Rastlanmadı.....", vbCritical, "N. YEŞERTENER"
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
 
    Range("I5:J" & Son).ClearContents
    Range("N5:O" & Son).ClearContents
    Range("R5:R" & Son).ClearContents
 
    For i = 5 To Son
        If Not Cells(i, "G") = "" And Not Cells(i, "H") = "" Then
            Sonuc = DereceKademe(Cells(i, "G"), Cells(i, "H"))
            Cells(i, "I") = Sonuc(0)
            Cells(i, "J") = Sonuc(1)
        Else
            Cells(i, "R") = "Aylık Hatalı"
        End If
        If Not Cells(i, "L") = "" And Not Cells(i, "M") Then
            Sonuc = DereceKademe(Cells(i, "L"), Cells(i, "M"))
            Cells(i, "N") = Sonuc(0)
            Cells(i, "O") = Sonuc(1)
        Else
            Cells(i, "R") = Cells(i, "R") & " Emekli Hatalı"
        End If
 
    Next i
 
    Application.ScreenUpdating = True
 
    MsgBox "AYLIK ve EMEKLİ YÖNÜNDEN YÜKSELECEĞİ DERECE/KADEME HESAPLANMIŞTIR...", vbInformation, "N. YEŞERTENER"
 
End Sub

Hesaplama Fonksiyonu

Kod:
Function DereceKademe(Derece As Integer, Kademe As Integer) As Variant()
 
    Kademe = Kademe + 1
    If Kademe > 3 Then
        If Derece > 3 Then
            Kademe = 1
            Derece = Derece - 1
        Else
            If Kademe > 9 Then Kademe = 9
        End If
    End If
 
    DereceKademe = Array(Derece, Kademe)
 
End Function

Derece/Kademe Düzeltme Kodları :

Kod:
Private Sub CommandButton3_Click()
                                    'Yükseleceği Derece/Kademeyi İlgili Derece/Kademeye Aktarır
    Dim i   As Long, _
        j   As Long, _
        Adt As Integer, _
        Flg As Boolean, _
        ShG As Worksheet
        
    Set ShG = Sheets("GENEL LİSTE 2014")
        
    For i = 5 To ShG.Cells(Rows.Count, "A").End(3).Row
    
        Flg = False
        If (ShG.Cells(i, "K") >= ShG.Range("D1") And ShG.Cells(i, "K") <= ShG.Range("E1")) Then
            Flg = True
            ShG.Cells(i, "G") = ShG.Cells(i, "I")
            ShG.Cells(i, "H") = ShG.Cells(i, "J")
            ShG.Range("I" & i & ":J" & i).ClearContents
            ShG.Range("K" & i) = DateAdd("yyyy", 1, ShG.Range("K" & i))
        End If
        
        If ShG.Cells(i, "P") >= ShG.Range("D1") And ShG.Cells(i, "P") <= ShG.Range("E1") Then
            Flg = True
            ShG.Cells(i, "L") = ShG.Cells(i, "N")
            ShG.Cells(i, "M") = ShG.Cells(i, "O")
            ShG.Range("N" & i & ":O" & i).ClearContents
            ShG.Range("P" & i) = DateAdd("yyyy", 1, ShG.Range("P" & i))
        End If
        
        If Flg = True Then Adt = Adt + 1
    
    Next i
    
    If Adt = 0 Then
        MsgBox "DÜZELTİLECEK ŞARTA UYGUN VERİ BULUNMADIM....", vbCritical
    Else
        MsgBox Adt & " Adet Personelin Derece/Kademe'si Düzeltilmiştir....", vbInformation
    End If
    
End Sub
 

Ekli dosyalar

Necdet Bey emekleriniz için çok Teşekkürler;
Anladığım kadarıyla CommandButton3 kodlarında bazı satırları silerek düşündüğüm olayı gerçekleştirdim. Siteden yararlanarak CommandButton3 aktive ve inaktif olayı ekledim. Çünkü yılda bir kez kullanılacağı için yanlışlıkla tıklanmasın diye. Dosyayı ekledim. Eksiklerim varsa incelerseniz sevinirim.
Teşekkürler
 

Ekli dosyalar

Son düzenleme:
Merhaba,

anladığım kadarıyla yeni yıla hazırlıkta tarihleri dikkate almadan yapmışsınız.

Bu durumda flg değişkenini kullanmanın bir anlamı yok.
aşağıdaki kodlarda kırmızı ile belirlediğim yerleri silebilirsiniz.

Kod:
    For i = 5 To ShG.Cells(Rows.Count, "A").End(3).Row
    
        [B][COLOR=red]Flg = False
[/COLOR][/B]        
            [COLOR=red][B]Flg = True
[/B][/COLOR]            ShG.Cells(i, "G") = ShG.Cells(i, "I")
            ShG.Cells(i, "H") = ShG.Cells(i, "J")
            ShG.Range("I" & i & ":J" & i).ClearContents
            ShG.Range("K" & i) = DateAdd("yyyy", 1, ShG.Range("K" & i))
       
            [B][COLOR=red]Flg = True
[/COLOR][/B]            ShG.Cells(i, "L") = ShG.Cells(i, "N")
            ShG.Cells(i, "M") = ShG.Cells(i, "O")
            ShG.Range("N" & i & ":O" & i).ClearContents
            ShG.Range("P" & i) = DateAdd("yyyy", 1, ShG.Range("P" & i))
       
        
        [B][COLOR=red]If Flg = True Then[/COLOR][/B] Adt = Adt + 1
    
    Next i
 
Necdet Bey; teşekkürler emekleriniz için.
Evet yeni yıla hazırlıkta tarihleri dikkate almadan yapmaya çalıştım.
 
Güle güle kullanınız.
 
Necdet Bey, Uzun süre önce çok emek verdiğiniz bu belgede küçük bir ilave yapmamız mümkün mü?

Derece kademe ilerleme tarihlerinde genel listeden, diğer sayfaya iilgili aylarda ilerleme yapacakların listesini aktarıyordu. Aynı kişinin maaş ve emekli kesenek derece kademeleri aynı tarihte ilerlemiyor. Aktarma yaparken sadece ilgili olduğu ayda hangi derece kademe ilerliyorsa onun aktarılması, diğerinde derece kademe hanesinde - yada * işareti koydurabilir miyiz. Örnek dosyayı ekledim incelerseniz sevinirim. Teşekkürler.
 

Ekli dosyalar

Necdet Bey, Uzun süre önce çok emek verdiğiniz bu belgede küçük bir ilave yapmamız mümkün mü?

Derece kademe ilerleme tarihlerinde genel listeden, diğer sayfaya iilgili aylarda ilerleme yapacakların listesini aktarıyordu. Aynı kişinin maaş ve emekli kesenek derece kademeleri aynı tarihte ilerlemiyor. Aktarma yaparken sadece ilgili olduğu ayda hangi derece kademe ilerliyorsa onun aktarılması, diğerinde derece kademe hanesinde - yada * işareti koydurabilir miyiz. Örnek dosyayı ekledim incelerseniz sevinirim. Teşekkürler.

Günaydın;
Allah razı olsun.Necdet beyin emekleri ile derece kademe dosyamın son haline aşağıdaki mesajda bahsettiğim şeyi yapabilir miyiz?
Bir diğer hususta 3 dereceden aşağı düşememe sınırlaması kaldırıldı onu kodlarda revize ettim ancak 1-4 maksimum olacak şekilde, yani personelin derece kademesi 1-4 ise 1-5 olmamasını sağlayabilir miyiz.
Teşekkürler.
 
Güncellemek için
 
Geri
Üst