PUANTAJ

[Selçuk.23]

Merhabalar; Kullanmakta olduğum Puantaj dosyasının güncellenmesi ve bir kaç ekleme yapılması gerekiyor. Yapılması gerekenler dosya içindeki açıklamada yazılı. Yardım edebilir misiniz?

[Selçuk.23]

Dosya içerisindeki yapılması gerekenlerden 1. madde: yıl güncellemesi ile 3. Maddeyi kendim hallettim. Sadece 2. Madde olan herhangi bir sebepten dolayı puantaja işlenmeyen izin/izinleri İZİN SAYFASINDA renk veya işaretleyecek şekilde düzenleyebilir misiniz?

[tasad]

Kodu deneyin.

Kod: Tümünü seç

Sub renk()
Dim i As Long
Set s1 = Sheets("PUANTAJ")
Set s4 = Sheets("izin takip")

s4.Range("a2:a" & Cells(Rows.Count, 1).End(3).Row).Interior.Pattern = xlNone

For i = 2 To s4.Cells(Rows.Count, 1).End(3).Row
  
        If Right(s4.Cells(i, 2), 4) <> s1.Range("a1").Text Then
            s4.Cells(i, "A").Interior.Color = vbYellow
                                   
        End If
Next

End Sub

[Selçuk.23]

Öncelikle yardım ve ilginiz için teşekkür ederim. Ancak deneme yaptığımda
1- izin sayfasında tarihlerdeki hatayı fark ettiyse de isimlerde olabilecek hatayı görmüyor. Örn; Emrah yerine hatayla emral yazsam dolayısıyla izin puantaja işlenmiyor ve kod hatayı görmüyor.
2- puantaj sayfasında nisan yerine Mayıs ayını hesapladığımda hic bir izin işlenmemesine rağmen kod işlenmemiş izinleri işaretlemedi. sanki 1 defaya mahsus işlem yaptı. daha da çalışmadı.
3- Bu puantajı her ay düzenli olarak kullanıyorum. haliyle her defasında ay ve izin tarihleri değişiyor, ve bütün hataları düzeltene kadar sürekli hesaplama yapıyorum. her hesaplama yaptığımda puantaj sayfasına herhangi bir nedenle işlenmemiş izinleri tespit etmem gerek.

[tasad]

Tarihlerle ilgi sorun çıkartmıyor.Ancak isimde soyisimde yanlış yazılmış olanlarda hata veriyor, puantaja yazmıyor.
Puantaj ve izin sayfalarında isimleri karşılaştırıp, izin sayfasında doğru olanların karşısına f kolonuna x yazar,isim yanlış ise boş bırakır. boş satırları filtreleyip hatalı yazılmış isimleri tespit edebilirsiniz.Kodu deneyin.

Kod: Tümünü seç

Sub Hatali_isimler()
Dim i As Long
Dim j As Long
Set s1 = Sheets("PUANTAJ")
Set s4 = Sheets("izin takip")
s4.Range("f2:f100000").Clear

For i = 2 To s4.Cells(Rows.Count, 1).End(3).Row
   For j = 7 To s1.Cells(Rows.Count, 2).End(3).Row
       
         If s4.Cells(i, 1) = s1.Cells(j, 2) Then
               s4.Cells(i, 6) = "x"
                
         End If
    Next

Next
End Sub

[Selçuk.23]

Merhabalar; Aslında çok güzel mantık yakalamışsınız.(Puantaj ve izin sayfalarında isimleri karşılaştırıp, izin sayfasında doğru olanların karşısına f kolonuna x yazar) bu mantığı isimler üzerinde değil de tarihler üzerinde bir karşılaştırma yapabilir miyiz? "izin takip" sayfasındaki tarih aralıklarını Puantaj sayfasındaki tarihlerde işlenip işlenmediğini karşılaştırsa ve işlenmeyenlerin f sütununda x koysa sorun biter. İmkansız bir işlem değildir uyarım. daha önce bir örneğini görmüştüm. eski siteyi altüst ettim bulamadım.

Bu kod yıl değişik olduğunda hatayı gösteriyor. ama ay farklı olduğunda hatayı göstermiyor, yine manuel kontrol etmek zorunda kalıyorum,

Tarihlerle ilgi sorun çıkartmıyor.Ancak isimde soyisimde yanlış yazılmış olanlarda hata veriyor, puantaja yazmıyor.
Puantaj ve izin sayfalarında isimleri karşılaştırıp, izin sayfasında doğru olanların karşısına f kolonuna x yazar,isim yanlış ise boş bırakır. boş satırları filtreleyip hatalı yazılmış isimleri tespit edebilirsiniz.Kodu deneyin.

Kod: Tümünü seç

Sub Hatali_isimler()
Dim i As Long
Dim j As Long
Set s1 = Sheets("PUANTAJ")
Set s4 = Sheets("izin takip")
s4.Range("f2:f100000").Clear

For i = 2 To s4.Cells(Rows.Count, 1).End(3).Row
   For j = 7 To s1.Cells(Rows.Count, 2).End(3).Row
       
         If s4.Cells(i, 1) = s1.Cells(j, 2) Then
               s4.Cells(i, 6) = "x"
                
         End If
    Next

Next
End Sub

[Selçuk.23]

Bu veya buna benzer bir kodu uyarlayabilirmisiniz.

If WorksheetFunction.CountIf(puantaj.Range("B2:B" & son1), izin.Cells(i, 1)) < 1 Then
izin.Range(izin.Cells(i, 1), izin.Cells(i, 6)).Interior.Color = vbYellow
izin.Cells(i, 6) = "İzni kaydedilemedi"
Else
puantaj.Range(puantaj.Cells(a + 1, b + 3), puantaj.Cells(a + 1, c + 3)) = izin.Cells(i, 4)
puantaj.Range(puantaj.Cells(a + 1, b + 3), puantaj.Cells(a + 1, c + 3)).Interior.Color = vbYellow
End If: Next i
Application.ScreenUpdating = True
MsgBox "Bitti", vbInformation, "userx"
End Sub

Tarihlerle ilgi sorun çıkartmıyor.Ancak isimde soyisimde yanlış yazılmış olanlarda hata veriyor, puantaja yazmıyor.
Puantaj ve izin sayfalarında isimleri karşılaştırıp, izin sayfasında doğru olanların karşısına f kolonuna x yazar,isim yanlış ise boş bırakır. boş satırları filtreleyip hatalı yazılmış isimleri tespit edebilirsiniz.Kodu deneyin.

Kod: Tümünü seç

Sub Hatali_isimler()
Dim i As Long
Dim j As Long
Set s1 = Sheets("PUANTAJ")
Set s4 = Sheets("izin takip")
s4.Range("f2:f100000").Clear

For i = 2 To s4.Cells(Rows.Count, 1).End(3).Row
   For j = 7 To s1.Cells(Rows.Count, 2).End(3).Row
       
         If s4.Cells(i, 1) = s1.Cells(j, 2) Then
               s4.Cells(i, 6) = "x"
                
         End If
    Next

Next
End Sub

[tasad]

Tarihlerde nasıl bir sorun var ki işleme yapmıyor.
Nisan yada mayıs ayını seçtiğimde izinleri sorunsuz işliyor.
Tarihlerdeki hata ile ilgi örnek verirseniz çözüm bulurum.
Anlattıklarınızdan pek fazla bir şey anlamadığım için tam çözümde sunamıyorum.

[Selçuk.23]

Dosya içindeki açıklamaları yeniledim.

[tasad]

Kodu deneyin.

Kod: Tümünü seç

Sub Hatali_TARIH()
Dim i As Long
Dim j As Long
Set s1 = Sheets("PUANTAJ")
Set s4 = Sheets("izin takip")
s4.Range("f2:f100000").Clear
   
For i = 2 To s4.Cells(Rows.Count, 1).End(3).Row
  For t = 7 To s1.Cells(Rows.Count, 2).End(3).Row

   For j = 5 To 35
 
 
         If CDate(s1.Cells(6, j)) >= CDate(s4.Cells(i, 2)) And _
         CDate(s1.Cells(6, j)) <= CDate(s4.Cells(i, 3)) And _
         s4.Cells(i, 1) = s1.Cells(t, 2) And s1.Cells(t, j).Value = "Y.İ" Then
               s4.Cells(i, 6) = "İşlendi"
              
         End If
         
    Next
  Next
  
        If s4.Cells(i, 6) = "" Then
            s4.Cells(i, 6) = "Puantaja İşlenmedi"
        End If
  
Next
End Sub

[Selçuk.23]

Bu kod bu haliyle mükemmel olmuş. bir çok deneme yaptım. yüzde 99 hatasız çalıştı. geri kalan yüzde 1 lık kısım ise s4.Cells(i, 1) = s1.Cells(t, 2) And s1.Cells(t, j).Value = "Y.İ" Then ; yıllık izin kısaltması olan Y.İ de sorunsuz çalıştı. diğer izin şekillerini girdiğimde çalışmadı.
S : Seminer
D.İ : Doğum İzni
M.İ : Mazeret İzni
RP : Rapor
Ü.İ : Ücretsiz İzin
A.A : Açıkta
T.Y : Tayin
S.İ : Süt İzni
EĞT : Eğitim
As. : ASKER
ama bu sorun olsada olur olmasada tarzında: bir hayli uğraştırdım sizi hakkınızı helal edin, Elinize emeğinize sağlık. teşekkürler,

Kodu deneyin.

Kod: Tümünü seç

Sub Hatali_TARIH()
Dim i As Long
Dim j As Long
Set s1 = Sheets("PUANTAJ")
Set s4 = Sheets("izin takip")
s4.Range("f2:f100000").Clear
   
For i = 2 To s4.Cells(Rows.Count, 1).End(3).Row
  For t = 7 To s1.Cells(Rows.Count, 2).End(3).Row

   For j = 5 To 35
 
 
         If CDate(s1.Cells(6, j)) >= CDate(s4.Cells(i, 2)) And _
         CDate(s1.Cells(6, j)) <= CDate(s4.Cells(i, 3)) And _
         s4.Cells(i, 1) = s1.Cells(t, 2) And s1.Cells(t, j).Value = "Y.İ" Then
               s4.Cells(i, 6) = "İşlendi"
              
         End If
         
    Next
  Next
  
        If s4.Cells(i, 6) = "" Then
            s4.Cells(i, 6) = "Puantaja İşlenmedi"
        End If
  
Next
End Sub