DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Izindeki_Personel()
Sub Izindeki_Personel()
Dim sListe As Worksheet, _
sVeri As Worksheet
Dim i As Long, _
j As Long
Dim Adet As Integer, _
k As Integer
Dim Tarih As Date
Set sListe = Sheets("İzindekiler")
Set sVeri = Sheets("izin izlenimi")
Tarih = sListe.Range("H2")
Application.ScreenUpdating = False
i = sListe.Cells(Rows.Count, "A").End(3).Row
If i < 3 Then i = 3
sListe.Range("A3:F" & i).ClearContents
j = 2
For i = 2 To sVeri.Cells(Rows.Count, "A").End(3).Row
If Tarih >= sVeri.Cells(i, "C") And Tarih <= sVeri.Cells(i, "D") Then
j = j + 1
Adet = Adet + 1
sListe.Cells(j, "A") = sVeri.Cells(i, "A")
sListe.Cells(j, "B") = sVeri.Cells(i, "C")
sListe.Cells(j, "C") = sVeri.Cells(i, "D")
For k = 5 To 13
If k < 6 Or k > 9 Then
If Not sVeri.Cells(i, k) = "" Then
sListe.Cells(j, "D") = sVeri.Cells(1, k)
sListe.Cells(j, "E") = sVeri.Cells(i, k)
Exit For
End If
End If
Next k
sListe.Cells(j, "F") = sVeri.Cells(i, "F")
End If
Next i
Application.ScreenUpdating = True
If Adet = 0 Then
MsgBox "Hiç Kimse " & Tarih & " Tarihinde İzinli Değil", vbCritical, "N. YEŞERTENER"
Else
MsgBox "İzinde Olan " & Adet & " Kişi Listelendi....", vbInformation, "N. YEŞERTENER"
End If
End SubOption Explicit
Sub Izindeki_Personel()
Dim hücre As Range, Sayfa_izlenim As Worksheet, Sayfa_izindekiler As Worksheet, Son_Satır As Long, U As Long
Set Sayfa_izlenim = Sheets("izin izlenimi")
Set Sayfa_izindekiler = Sheets("İzindekiler")
Sayfa_izindekiler.Range("A3:F" & Sayfa_izindekiler.Cells(Rows.Count, "F").End(3).Row).ClearContents
For U = 2 To Sayfa_izlenim.Cells(Rows.Count, "C").End(3).Row
If Sayfa_izlenim.Cells(U, "C") <= Sayfa_izindekiler.Range("H2") And Sayfa_izlenim.Cells(U, "O") >= Sayfa_izindekiler.Range("H2") Then
Son_Satır = Sayfa_izindekiler.Cells(Rows.Count, "A").End(3).Row + 1
Sayfa_izindekiler.Cells(Son_Satır, "A") = Sayfa_izlenim.Cells(U, "A")
Sayfa_izindekiler.Cells(Son_Satır, "B") = CDate(Sayfa_izlenim.Cells(U, "C"))
Sayfa_izindekiler.Cells(Son_Satır, "C") = CDate(Sayfa_izlenim.Cells(U, "O"))
For Each hücre In Sayfa_izlenim.Range("I" & U & ":N" & U)
If hücre > 0 Then
Sayfa_izindekiler.Cells(Son_Satır, "D") = Sayfa_izlenim.Cells(1, hücre.Column)
Sayfa_izindekiler.Cells(Son_Satır, "E") = Sayfa_izlenim.Cells(hücre.Row, hücre.Column)
End If
Next
Sayfa_izindekiler.Cells(Son_Satır, "F") = CDate(Sayfa_izlenim.Cells(U, "F"))
End If
Next
End Sub