• 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 siz kamuyu bırakalı düzelme yerine ..... neyse, suç işletmeyin bana:)
Bizde 3269 sayılı personel olduğundan, bu kanuna tabi personelde böyle bir sınırlama var ne mezunu olduğunuzun önemi yok. Üçüncü dereceden aşağı düşemiyorlar.
 
Necdet Bey siz kamuyu bırakalı düzelme yerine ..... neyse, suç işletmeyin bana:)
Bizde 3269 sayılı personel olduğundan, bu kanuna tabi personelde böyle bir sınırlama var ne mezunu olduğunuzun önemi yok. Üçüncü dereceden aşağı düşemiyorlar.


Halen kamuda çalışıyorum da bu işlerle uğraşmıyorum :)

Aynı mantık geçerli mi? Bana garip gelen bir mantık var, onu açıklayım :

"Genel Liste" sayfasında siz hem maaş hem emeklilik yönünden ilerleyeceği Dereceyi ve Kademeyi belirliyorsunuz, bunu neden yapıyorsunuz?
Terfi olduğunda bunun bir anlamı kalmıyor.

Böyle yapılacağına "Genel Liste" sayfasında doğrudan terfi eden personelin derece ve kademesi düzenlense sonrada işte şu şu kişiler terfi etti deyip "Terfi Edenler Listesi" adı altında bir sayfada bunları aktarılsa olmaz mı?

Bir düşünün ona göre kod geliştirelim, yok bu mantıkla gidelim derseniz kodları ona göre düzenleyelim.
 
Necdet Bey, Bana göre de mantık olarak sizin dediğiniz doğru ancak, Genel listede sadece mevcut maaş derece kademesi ve mevcut emekli keseneğine esas derece kademesinin bulunması, Derece Kademe sayfasında da halen mevcut liste şeklinde olması gerekir.

Şu şekilde yapabiliriz.
Genel Liste sayfasında sadece 1.kez tüm derece kademeleri tarihine bakılmaksızın ilerletiriz ve (Şahsi fikrim;Örn:K1 sayfasına daha önce derece kademe ilermelesi yapıldı mesajı çıkar ikindi defa ilerleme yapılması engellenebilir) Daha sonra D1 ve E1 deki tarih aralığındaki ilerleme yapanları derece kademe sayfasına aktarırız.(Aylık olarak yayımlayabilmek için)

Ama kurumun formatı bu şekilde olduğu için mevcut liste üzerinden ilerlersek iyi olacak.
Teşekkürler.
 
Son düzenleme:
Merhaba,

Kodların ve dosyanın son hali ekte.

Kademeyi 9 a kadar götürdüm, umarım bunda bir sıkıntı yoktur.

Arşiv sayfası ekledim, mantığı sizin düşündüğünüz gibi mi bilemiyorum, inceleyiniz.

Kod:
Sub Aktar()
    
    Dim i   As Long, _
        j   As Long, _
        Adt As Integer, _
        Der As Integer, _
        Kad As Integer, _
        Flg As Boolean, _
        Ayl As Boolean, _
        Eml As Boolean, _
        ShG As Worksheet, _
        ShD As Worksheet
    Set ShG = Sheets("GENEL LİSTE 2014")
    Set ShD = Sheets("Derece Kademe")
    
    ShG.Select
    
    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
            ShG.Range("A" & i & ":P" & i).Copy ShD.Range("A" & j)
            'Aylık Terfi Kontrolü
            If Ayl = True Then
                Der = ShD.Cells(j, "I")
                Kad = ShD.Cells(j, "J")
                ShD.Cells(j, "G") = Der
                ShD.Cells(j, "H") = Kad
                Kad = Kad + 1
                If Kad > 3 Then
                    If Der > 3 Then
                        Kad = 1
                        Der = Der - 1
                    Else
                        If Kad > 9 Then Kad = 9
                    End If
                End If
                ShD.Cells(j, "I") = Der
                ShD.Cells(j, "J") = Kad
            End If
            'Emekli Terfi Kontrolü
            If Eml = True Then
                Der = ShD.Cells(j, "N")
                Kad = ShD.Cells(j, "O")
                ShD.Cells(j, "L") = Der
                ShD.Cells(j, "M") = Kad
                Kad = Kad + 1
                If Kad > 3 Then
                    If Der > 3 Then
                        Kad = 1
                        Der = Der - 1
                    Else
                        If Kad > 9 Then Kad = 9
                    End If
                End If
                ShD.Cells(j, "N") = Der
                ShD.Cells(j, "O") = Kad
           
            End If
        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

Arşiv sayfasına aktaran kodlar (Derece Kademe sayfasının kod bölümünde olmalı)

Kod:
Private Sub CommandButton1_Click()
    
    Dim i   As Long, _
        j   As Long, _
        ShA As Worksheet
    
    Set ShA = Sheets("Arşiv")
    
    j = ShA.Cells(Rows.Count, "B").End(3).Row + 1
    If j < 4 Then j = 4
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 4 Then
        MsgBox "Boş Olan Sayfanın Neresini Arşive Atayım?", vbCritical, "N. YEŞERTENER"
        Exit Sub
    End If
    
    Range("A5:P" & i).Copy ShA.Range("A" & j)
    
    MsgBox "ARŞİV SAYFASINA AKTARILMIŞTIR...", vbInformation, "N. YEŞERTENER"
    
End Sub
 

Ekli dosyalar

Necdet Bey eline sağlık şimdilik gayet güzel, ufak bir şey daha rica edebilirmiyim.
Daha önce arşive aktarılan bilgileri tekrar arşive atmaması için bir sınırlama koyabilirmiyiz? Arşivdeki bilgileri kontrol edip daha önce o personel arşive akratıldıysa; bu bilgiler daha önce arşive aktarıldı gibi bir uyarı versin ve aktarma yapmasın.
Teşekkürler
 
Necdet Bey eline sağlık şimdilik gayet güzel, ufak bir şey daha rica edebilirmiyim.
Daha önce arşive aktarılan bilgileri tekrar arşive atmaması için bir sınırlama koyabilirmiyiz? Arşivdeki bilgileri kontrol edip daha önce o personel arşive akratıldıysa; bu bilgiler daha önce arşive aktarıldı gibi bir uyarı versin ve aktarma yapmasın.
Teşekkürler

Bu zaten benim aklımda olan bir olaydı, fakat nasıl kontrol edeceğimi bilemediğim için sesimi çıkartmadım.

A kişisi bir tarihte maaş yönünden terfi etti diyelim, bir kaç ay sonra emekli yönünden terfi etse, bunu nasıl kontrol etmek gerekir?

Yani formül sizde :)
 
Evet haklısınız Necdet bey; Ben proğram yönünden anlamadığım için orasını hiç düşünemedim.Dolayısıyla başa döndüm şimdi:(
Size çok yük olduğumun farkındayım kusuruma bakmayın. O zaman 23 mesajın 2'nci parağrafındaki yazdığım şekilde düzenlememiz çokmu zahmetli olur?
Teşekkürler.
 
Şu şekilde yapabiliriz.
Genel Liste sayfasında sadece 1.kez tüm derece kademeleri tarihine bakılmaksızın ilerletiriz ve (Şahsi fikrim;Örn:K1 sayfasına daha önce derece kademe ilermelesi yapıldı mesajı çıkar ikindi defa ilerleme yapılması engellenebilir) Daha sonra D1 ve E1 deki tarih aralığındaki ilerleme yapanları derece kademe sayfasına aktarırız.(Aylık olarak yayımlayabilmek için)

Ama kurumun formatı bu şekilde olduğu için mevcut liste üzerinden ilerlersek iyi olacak.
Teşekkürler.


Evet haklısınız Necdet bey; Ben proğram yönünden anlamadığım için orasını hiç düşünemedim.Dolayısıyla başa döndüm şimdi:(
Size çok yük olduğumun farkındayım kusuruma bakmayın. O zaman 23 mesajın 2'nci parağrafındaki yazdığım şekilde düzenlememiz çokmu zahmetli olur?
Teşekkürler.

Tam olarak anlamadım, tüm derece ve kademeleri mi (ve yükseleceği de dahil olmak üzere) arttırmak istiyorsunuz? Bu doğru bir düşünce olabilir mi?

Karar sizin.
 
Necdet bey; Mevcut belgede (hem maaş hem emekli keseneklerinde) yükseleceği derece kademenin boş olduğunu düşünün, almakta olduğu aylığına bakarak, yükseleceği derece kademeleri ilerletmiş olacağız. Sonraki yıldada, yükselmiş olduğu derece kademeleri almakta olduğu derece kademe bölümüne kopyabiliriz.
 
Merhaba,

yani sadece yükseleceği Der/Kad (hem aylık hem emekli yönünden) hesaplanacak, doğru mu anladım?
 
Aynen öyle, Genel liste sayfasında yeni derece kademeleri ilerleyecek (hem maaş, hem emekli yönünden) daha sonra diğer sayfaya (tarihi uyanların) aktarılması sağlandığı zaman olacak.(Aylık olarak yayınlanması için)
 
Merhaba,

Gerek işlerin yoğunluğu gerekse evdeki internetteki arıza nedeniyle dönüşüm geç oldu, idare edin artık :)

Derece ve kademe hesaplamasını fonksiyon haline getirdim. Dolayısıyla ilerleme işlemini tek bir yerden kontrol etmek daha kolay oldu.

Aktarma kodlarına daha önce aktarılıp aktarılmadığının kontrolünü koydum.

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)
            'Aylık Terfi Kontrolü
            If Ayl = True Then
                ShD.Cells(j, "G") = ShD.Cells(j, "I")
                ShD.Cells(j, "H") = ShD.Cells(j, "J")
                Sonuc = DereceKademe(ShD.Cells(j, "I"), ShD.Cells(j, "J"))
                ShD.Cells(j, "I") = Sonuc(0)
                ShD.Cells(j, "J") = Sonuc(1)
            End If
 
            'Emekli Terfi Kontrolü
            If Eml = True Then
                ShD.Cells(j, "L") = ShD.Cells(j, "N")
                ShD.Cells(j, "M") = ShD.Cells(j, "O")
                Sonuc = DereceKademe(ShD.Cells(j, "N"), ShD.Cells(j, "O"))
                ShD.Cells(j, "N") = Sonuc(0)
                ShD.Cells(j, "O") = Sonuc(1)
            End If
        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


Derece Kademe 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
 

Ekli dosyalar

Necdet bey çok emek verdiniz teşekkürler,
Denemelerimde;Derece kademe sayfasına aktarırken bir kez daha Mevcut almakta oldukları dereceler aynen kalıyor kademeler bir kez daha ilerliyor.
Buna bir bakabilirmisiniz?
Teşekkürler.
 
Necdet bey çok emek verdiniz teşekkürler,
Denemelerimde;Derece kademe sayfasına aktarırken bir kez daha Mevcut almakta oldukları dereceler aynen kalıyor kademeler bir kez daha ilerliyor.
Buna bir bakabilirmisiniz?
Teşekkürler.

Mantığı değiştirdim, ama tam kontrol etmemiştim :) şaşırmışım demekki, 32. mesajdaki kodlar ve Dosya yenilenmiştir.

Silerken kodları fazla silmişim nedeni buymuş :)
 
Necdet Bey; hala kodlarda silinmesi gereken yerler var. Derece Kademe sayfasına atarken her satırda farklı sonuçlar veriyor. Aktar butonu;tarihi uyan satırların bilgilerini aktaracak. Derece kademeleri bozarak aktarıyor. Dosya ekte incelerseniz sevinirim.
Teşekkürler.
 

Ekli dosyalar

Merhaba,

Değişkenleri değiştirmeyi unutmuşum bu seferde :)
Bu sefer işlem tamamdır.
kodları ve dosyayı yeniledim, inceleyiniz.
 
Necdet Bey;yanlış dosya yüklemişsiniz sanırım. Bi incelermisiniz? Daha önceki dosyada kodları denedim aynı sonucu veriyor.
Genel listedeki yükseleceği derece kademe hesaplama butonu proplemsiz çalışıyor aktar butonu sadece iki tarih arasındaki verileri aktaracak başka bir işlem yapmaması lazım.
Teşekkürler.
 
Son düzenleme:
Dosyayı yeniledim :)
Hay allah bana ne oldu böyle ya
 
Necdet Bey; siz biraz kafayı dinleyin bir daha bakın dosyaya, herhalde başka şeyler var kafanızda:) Gene derece kademe sayfasına aktarma yaparken kademeleri ilerletiyor.
 
Necdet Bey; siz biraz kafayı dinleyin bir daha bakın dosyaya, herhalde başka şeyler var kafanızda:) Gene derece kademe sayfasına aktarma yaparken kademeleri ilerletiyor.

Ee ilerletmesi gerekmiyor mu?

Aylık 10/1 ilerleyeceği 10/2

aktardıktan sonra Aylık 10/2 yükseleceği 10/3 olması gerekmiyor mu?

Aynı mantık emeklilik açısından da öyle.
 
Geri
Üst