Açık olan iki dosya arasında karşılaştırma ve değer girme hk.

Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Merhaba.
Elimde izinler ve puantaj diye 2 ayrı excel çalışma dosyam var.
Yapmak istediğim, izinler dosyasına işlemiş olduğum girdileri "AKTAR" tuşuna basarak, çalışmakta olan (açık olan) puantaj dosyasına 100 kişiden ilgili olanları bulup örnekte olduğu gibi işleme yapması.

Not: Puantaj dosyasında CR3 hücresi değiştiğinde BC7:CG7 hücreleri otomatik değişiyor.
Not2: Puantajda, Yıllık İzin = Yİ,, Rapor = R,,, Ücretsiz İzin = Üİ,,, Doğum/Babalık/Ölüm İzni = M,,, Ücretli İzin = İ olarak gösteriliyor.

Şimdiden teşekkürler.
 

Ekli dosyalar

Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Değerli üstadlar,
sizler için çok zor bir çalışma olmadığını bilirim.
Lütfen Allah rızası için bir el atınız.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Izinleri_Aktar()
    Dim K1 As Workbook, K2 As Workbook, S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Olmayan_Personeller As String
    Dim Personel As Range, Y As Date, Gun As Integer, Say As Long
    Dim Izin_Turu As String, Son_Tarih As Date
    
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
    
    Set K2 = Workbooks("Puantaj.xlsm")
    Set S2 = K2.Sheets("PUANTAJ")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    For X = 103 To Son
        If S1.Cells(X, 1) <> "" Then
            If S1.Cells(X, 6) <> "" And S1.Cells(X, 6) > 0 Then
                Select Case S1.Cells(X, 4)
                    Case "YILLIK İZİN": Izin_Turu = "Yİ"
                    Case "RAPOR": Izin_Turu = "R"
                    Case "ÜCRETSİZ İZİN": Izin_Turu = "Üİ"
                    Case "DOĞUM İZNİ": Izin_Turu = "M"
                    Case "ÜCRETLİ İZİN": Izin_Turu = "İ"
                    Case Else: Izin_Turu = "Tanımsız"
                End Select
                
                Set Personel = S2.Range("C:C").Find(S1.Cells(X, 1), , , xlWhole)
                If Not Personel Is Nothing Then
                    Son_Tarih = S1.Cells(X, 3)
                    If Month(S1.Cells(X, 2)) <> Month(S1.Cells(X, 3)) Then
                        Son_Tarih = DateSerial(Year(S1.Cells(X, 2)), Month(S1.Cells(X, 2)) + 1, 0)
                    End If
                    For Y = S1.Cells(X, 2) To Son_Tarih
                        Gun = WorksheetFunction.Match(CLng(Y), S2.Rows("5:5"), 0)
                        If Gun <> 0 Then
                            Say = Say + 1
                            S2.Cells(Personel.Row, Gun) = Izin_Turu
                            If Izin_Turu = "Yİ" Then
                                If S1.Cells(X, 6) >= 7 Then
                                    If UCase(Replace(Replace(S1.Cells(X, 5), "ı", "I"), "i", "İ")) = _
                                        UCase(Replace(Replace(Format(S2.Cells(5, Gun), "dddd"), "ı", "I"), "i", "İ")) Then
                                        S2.Cells(Personel.Row, Gun) = "T"
                                    Else
                                        S2.Cells(Personel.Row, Gun) = Izin_Turu
                                    End If
                                End If
                            End If
                        End If
                    Next
                Else
                    If Olmayan_Personeller = "" Then
                        Olmayan_Personeller = S1.Cells(X, 1)
                    Else
                        Olmayan_Personeller = Olmayan_Personeller & vbCr & S1.Cells(X, 1)
                    End If
                End If
            End If
        End If
    Next
    
    K2.Activate
    S2.Select
    
    Set Personel = Nothing
    Set K1 = Nothing
    Set S1 = Nothing
    Set K2 = Nothing
    Set S2 = Nothing
    
    If Say > 0 Then
        If Olmayan_Personeller <> "" Then
            MsgBox "İzinler aktarılmıştır." & vbCr & vbCr & _
                   "Aşağıdaki personeller puantaj dosyasında bulunamadı!" & vbCr & vbCr & _
                   Olmayan_Personeller, vbExclamation
        Else
            MsgBox "İzinler aktarılmıştır.", vbInformation
        End If
    Else
        MsgBox "Aktarılacak izin bulunamadı!", vbExclamation
    End If
End Sub
 
Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Deneyiniz.

C++:
Option Explicit

Sub Izinleri_Aktar()
    Dim K1 As Workbook, K2 As Workbook, S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Olmayan_Personeller As String, Say As Long
    Dim Personel As Range, Y As Date, Gun As Integer, Izin_Turu As String
   
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
   
    Set K2 = Workbooks("Puantaj.xlsm")
    Set S2 = K2.Sheets("PUANTAJ")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
   
    For X = 103 To Son
        If S1.Cells(X, 1) <> "" Then
            Select Case S1.Cells(X, 4)
                Case "YILLIK İZİN": Izin_Turu = "Yİ"
                Case "RAPOR": Izin_Turu = "R"
                Case "ÜCRETSİZ İZİN": Izin_Turu = "Üİ"
                Case "DOĞUM İZNİ": Izin_Turu = "M"
                Case "ÜCRETLİ İZİN": Izin_Turu = "İ"
                Case Else: Izin_Turu = "Tanımsız"
            End Select
           
            Set Personel = S2.Range("C:C").Find(S1.Cells(X, 1), , , xlWhole)
            If Not Personel Is Nothing Then
                For Y = S1.Cells(X, 2) To S1.Cells(X, 3)
                    Gun = WorksheetFunction.Match(CLng(Y), S2.Rows("5:5"), 0)
                    If Gun <> 0 Then
                        Say = Say + 1
                        S2.Cells(Personel.Row, Gun) = Izin_Turu
                    End If
                Next
            Else
                If Olmayan_Personeller = "" Then
                    Olmayan_Personeller = S1.Cells(X, 1)
                Else
                    Olmayan_Personeller = Olmayan_Personeller & vbCr & S1.Cells(X, 1)
                End If
            End If
        End If
    Next
   
    K2.Activate
    S2.Select
   
    Set Personel = Nothing
    Set K1 = Nothing
    Set S1 = Nothing
    Set K2 = Nothing
    Set S2 = Nothing
   
    If Say > 0 Then
        If Olmayan_Personeller <> "" Then
            MsgBox "İzinler aktarılmıştır." & vbCr & vbCr & _
                   "Aşağıdaki personeller puantaj dosyasında bulunamadı!" & vbCr & vbCr & _
                   Olmayan_Personeller, vbExclamation
        Else
            MsgBox "İzinler aktarılmıştır.", vbInformation
        End If
    Else
        MsgBox "Aktarılacak izin bulunamadı!", vbExclamation
    End If
End Sub
Korhan bey,
Desteğiniz için çok teşekkür ederim.
Tek bir sıkıntı çıktı, o da,
girilmiş olan bitiş tarihi, eğer bir sonraki aya kadar devam ediyorsa hata verip işlemi kesiyor.
Böyle bir senaryo da işlemi, "ay sonuna kadar diye değerlendir" şeklinde düzenleyebilir miyiz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
#4 nolu mesajımda ki kodu revize ettim. Tekrar deneyiniz.
 
Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Bir de,
Çok uğraştırmayacaksa, Yıllık izni aktarırken, 7 gün ve üzeri izin kullanmışsa, İZİNLER dosyasında ki "E" sütununda hafta tatili hangi gün yazılmışsa sıra o güne gelince "T" ataması yaptırabilir miyiz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu kontrol sadece YILLIK İZİN olanlar için mi olacak?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
#4 nolu mesajımda ki kodu tekrar revize ettim. Deneyiniz.
 
Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Korhan bey,
Bundan bir önceki revizasyonunuzda tüm kayıtlar eksiksiz bir şekilde işlenmekte idi.
Bu son düzenlediğiniz de ise bazı Yıllık izin girdilerini atlıyor. Aktarımını yapmıyor.
Hafta tatili pazar olanlara "T" yi koyuyor ama pazar olmayanları pas geçip sıraya "Yİ" basıyor.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Tekrar revize ettim. Deneyiniz.
 
Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Korhan Bey günaydın.
Denedim ve sanırım 6 gün ve aşağısı olan Yıllık izinlerin aktarımını yapmıyor. Bir önceki sürümde istisnasız aktarımını yapmaktaydı.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sorguyu ters yere eklemişim. Ondan dolayı sorun olmuş. Yeniden deneyiniz.
 
Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Korhan Bey tekrar merhaba.
Korhan bey,
İzinler dosyasının adını vardiya olarak değiştirsek ve örnek olarak,
Başlangıç Tarihini: 01/03/21
Bitiş Tarihini: 31/03/21
İzin Türünü: Hafta Tatili
İzin gününü: Misal Perşembe yapsak;
Puantajda Perşembe günlerine "T" geri kalan günlere "X" nasıl yazdırırız acaba?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Vardiya_Aktar()
    Dim K1 As Workbook, K2 As Workbook, S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Olmayan_Personeller As String
    Dim Personel As Range, Y As Date, Gun As Integer, Say As Long
    Dim Izin_Turu As String, Son_Tarih As Date
    
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
    
    Set K2 = Workbooks("Puantaj.xlsm")
    Set S2 = K2.Sheets("PUANTAJ")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    For X = 103 To Son
        If S1.Cells(X, 1) <> "" Then
            If S1.Cells(X, 6) <> "" And S1.Cells(X, 6) > 0 Then
                Select Case S1.Cells(X, 4)
                    Case "HAFTA TATİLİ": Izin_Turu = "X"
                    Case Else: Izin_Turu = "Tanımsız"
                End Select
                
                Set Personel = S2.Range("C:C").Find(S1.Cells(X, 1), , , xlWhole)
                If Not Personel Is Nothing Then
                    Son_Tarih = S1.Cells(X, 3)
                    If Month(S1.Cells(X, 2)) <> Month(S1.Cells(X, 3)) Then
                        Son_Tarih = DateSerial(Year(S1.Cells(X, 2)), Month(S1.Cells(X, 2)) + 1, 0)
                    End If
                    For Y = S1.Cells(X, 2) To Son_Tarih
                        Gun = WorksheetFunction.Match(CLng(Y), S2.Rows("5:5"), 0)
                        If Gun <> 0 Then
                            Say = Say + 1
                            S2.Cells(Personel.Row, Gun) = Izin_Turu
                            If UCase(Replace(Replace(S1.Cells(X, 5), "ı", "I"), "i", "İ")) = _
                                UCase(Replace(Replace(Format(S2.Cells(5, Gun), "dddd"), "ı", "I"), "i", "İ")) Then
                                S2.Cells(Personel.Row, Gun) = "T"
                            Else
                                S2.Cells(Personel.Row, Gun) = Izin_Turu
                            End If
                        End If
                    Next
                Else
                    If Olmayan_Personeller = "" Then
                        Olmayan_Personeller = S1.Cells(X, 1)
                    Else
                        Olmayan_Personeller = Olmayan_Personeller & vbCr & S1.Cells(X, 1)
                    End If
                End If
            End If
        End If
    Next
    
    K2.Activate
    S2.Select
    
    Set Personel = Nothing
    Set K1 = Nothing
    Set S1 = Nothing
    Set K2 = Nothing
    Set S2 = Nothing
    
    If Say > 0 Then
        If Olmayan_Personeller <> "" Then
            MsgBox "Vardiyalar aktarılmıştır." & vbCr & vbCr & _
                   "Aşağıdaki personeller puantaj dosyasında bulunamadı!" & vbCr & vbCr & _
                   Olmayan_Personeller, vbExclamation
        Else
            MsgBox "Vardiyalar aktarılmıştır.", vbInformation
        End If
    Else
        MsgBox "Aktarılacak vardiya bulunamadı!", vbExclamation
    End If
End Sub
 
Katılım
20 Eylül 2018
Mesajlar
132
Excel Vers. ve Dili
2016-Türkçe
Hocam ellerinize sağlık.
Allah razı olsun..
 
Üst