• DİKKAT

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

Derece ve Kademe Hesaplama

M

musaagac

Katılım
15 Haziran 2008
Mesajlar
286
Excel Vers. ve Dili
XP Office 2003
Arkadaşlar ekte göndermiş olduğum çalışmada yapmak istediklerim yazılı yardımcı olurmusunuz.
 

Ekli dosyalar

Aşağıdaki kodlarla yapabilirsiniz:

Kod: 
Sub terfi()
For i = 6 To Cells(Rows.Count, 1).End(3).Row
If Cells(i, "e") = 1 And Cells(i, "f") = 4 Then
Cells(i, "h") = 1
Cells(i, "I") = 4
Else
If Cells(i, "e") = 1 And Cells(i, "f") = 3 Then
Cells(i, "h") = 1
Cells(i, "I") = 4
Else
If Cells(i, "f") >= 3 Then
Cells(i, "I") = 1
Cells(i, "h") = WorksheetFunction.Max(Cells(i, "e") - 1, 1)
Else
Cells(i, "h") = Cells(i, "e")
Cells(i, "I") = Cells(i, "f") + 1
End If
End If
End If
If Cells(i, "k") = 1 And Cells(i, "l") = 4 Then
Cells(i, "n") = 1
Cells(i, "o") = 4
Else
If Cells(i, "k") = 1 And Cells(i, "l") = 3 Then
Cells(i, "n") = 1
Cells(i, "o") = 4
Else
If Cells(i, "l") >= 3 Then
Cells(i, "o") = 1
Cells(i, "n") = WorksheetFunction.Max(Cells(i, "k") - 1, 1)
Else
Cells(i, "n") = Cells(i, "k")
Cells(i, "o") = Cells(i, "l") + 1
End If
End If
End If
Next
End Sub

Yalnız bu kodlar şimdilik eğitim durumunu dikkate almıyor. Onu da eklemek için uğraşacağım.
 
Öğrenim düzeyine göre ayarlamaya çalıştım. Lütfen deneyip sonuç bildiriniz. Terfi tarihi için de uğraşacağım:

Kod: 
Sub terfi()
For i = 6 To Cells(Rows.Count, 1).End(3).Row
If Cells(i, "c") = "Lisans" Or Cells(i, "c") = "Önlisans" Then
    If Cells(i, "e") = 1 And Cells(i, "f") = 4 Then
        Cells(i, "h") = 1
        Cells(i, "I") = 4
    Else
    If Cells(i, "e") = 1 And Cells(i, "f") = 3 Then
        Cells(i, "h") = 1
        Cells(i, "I") = 4
    Else
    If Cells(i, "f") >= 3 Then
        Cells(i, "I") = 1
        Cells(i, "h") = WorksheetFunction.Max(Cells(i, "e") - 1, 1)
    Else
    Cells(i, "h") = Cells(i, "e")
    Cells(i, "I") = Cells(i, "f") + 1
    End If
    End If
    End If
End If
If Cells(i, "c") = "Lisans" Or Cells(i, "c") = "Önlisans" Then
    If Cells(i, "k") = 1 And Cells(i, "l") = 4 Then
        Cells(i, "n") = 1
        Cells(i, "o") = 4
    Else
    If Cells(i, "k") = 1 And Cells(i, "l") = 3 Then
        Cells(i, "n") = 1
        Cells(i, "o") = 4
    Else
    If Cells(i, "l") >= 3 Then
        Cells(i, "o") = 1
        Cells(i, "n") = WorksheetFunction.Max(Cells(i, "k") - 1, 1)
    Else
        Cells(i, "n") = Cells(i, "k")
        Cells(i, "o") = Cells(i, "l") + 1
    End If
    End If
    End If
Else
    If Cells(i, "e") = 2 Then
        Cells(i, "h") = 2
        Cells(i, "I") = WorksheetFunction.Min(6, Cells(i, "f") + 1)
    Else
    If Cells(i, "e") > 2 And Cells(i, "f") >= 3 Then
        Cells(i, "I") = 1
        Cells(i, "h") = WorksheetFunction.Max(Cells(i, "e") - 1, 2)
    Else
    If Cells(i, "e") > 2 Then
        Cells(i, "h") = Cells(i, "e")
        Cells(i, "I") = Cells(i, "f") + 1
    End If
    End If
    End If
If Cells(i, "k") = 2 Then
    Cells(i, "n") = 2
    Cells(i, "o") = WorksheetFunction.Min(6, Cells(i, "l") + 1)
Else
If Cells(i, "l") >= 3 Then
    Cells(i, "o") = 1
    Cells(i, "n") = WorksheetFunction.Max(Cells(i, "k") - 1, 2)
Else
    Cells(i, "n") = Cells(i, "k")
    Cells(i, "o") = Cells(i, "l") + 1
End If
End If
End If


Next
End Sub
 
Kıde yılı ve terfi tarihlerini de ekledim. Onlar için bir kısıtlama belirtmediğiniz için bir yıl arttırma şeklinde ayarladım:

Kod: 
Sub terfi()
For i = 6 To Cells(Rows.Count, 1).End(3).Row
If Cells(i, "c") = "Lisans" Or Cells(i, "c") = "Önlisans" Then
    If Cells(i, "e") = 1 And Cells(i, "f") = 4 Then
        Cells(i, "h") = 1
        Cells(i, "I") = 4
    Else
    If Cells(i, "e") = 1 And Cells(i, "f") = 3 Then
        Cells(i, "h") = 1
        Cells(i, "I") = 4
    Else
    If Cells(i, "f") >= 3 Then
        Cells(i, "I") = 1
        Cells(i, "h") = WorksheetFunction.Max(Cells(i, "e") - 1, 1)
    Else
    Cells(i, "h") = Cells(i, "e")
    Cells(i, "I") = Cells(i, "f") + 1
    End If
    End If
    End If
End If
If Cells(i, "c") = "Lisans" Or Cells(i, "c") = "Önlisans" Then
    If Cells(i, "k") = 1 And Cells(i, "l") = 4 Then
        Cells(i, "n") = 1
        Cells(i, "o") = 4
    Else
    If Cells(i, "k") = 1 And Cells(i, "l") = 3 Then
        Cells(i, "n") = 1
        Cells(i, "o") = 4
    Else
    If Cells(i, "l") >= 3 Then
        Cells(i, "o") = 1
        Cells(i, "n") = WorksheetFunction.Max(Cells(i, "k") - 1, 1)
    Else
        Cells(i, "n") = Cells(i, "k")
        Cells(i, "o") = Cells(i, "l") + 1
    End If
    End If
    End If
Else
    If Cells(i, "e") = 2 Then
        Cells(i, "h") = 2
        Cells(i, "I") = WorksheetFunction.Min(6, Cells(i, "f") + 1)
    Else
    If Cells(i, "e") > 2 And Cells(i, "f") >= 3 Then
        Cells(i, "I") = 1
        Cells(i, "h") = WorksheetFunction.Max(Cells(i, "e") - 1, 2)
    Else
    If Cells(i, "e") > 2 Then
        Cells(i, "h") = Cells(i, "e")
        Cells(i, "I") = Cells(i, "f") + 1
    End If
    End If
    End If
If Cells(i, "k") = 2 Then
    Cells(i, "n") = 2
    Cells(i, "o") = WorksheetFunction.Min(6, Cells(i, "l") + 1)
Else
If Cells(i, "l") >= 3 Then
    Cells(i, "o") = 1
    Cells(i, "n") = WorksheetFunction.Max(Cells(i, "k") - 1, 2)
Else
    Cells(i, "n") = Cells(i, "k")
    Cells(i, "o") = Cells(i, "l") + 1
End If
End If
End If
Cells(i, "r") = Cells(i, "q") + 1
Cells(i, "j").FormulaR1C1 = "=DATE(YEAR(RC[-3])+1,MONTH(RC[-3]),DAY(RC[-3]))"
Cells(i, "j") = Cells(i, "j").Value
Cells(i, "p").FormulaR1C1 = "=DATE(YEAR(RC[-3])+1,MONTH(RC[-3]),DAY(RC[-3]))"
Cells(i, "p") = Cells(i, "p").Value
Next
End Sub

Bu kodları nasıl çalıştıracağım derseniz:

Kodları bir modüle yapıştırın
Ya dosyanıza bir düğme ekleyip terfi makrosunu atayın
Ya da dosyanızdaki Terfi Hesapla comman butonunun kodlarına sadece terfi yazın. YAni şöyle olsun:
Kod: 
Private Sub CommandButton1_Click()
terfi
End Sub
 
tşk ederim yardımlarınız için.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst