nongeyikm
Altın Üye
- Katılım
- 7 Kasım 2005
- Mesajlar
- 495
- Excel Vers. ve Dili
- Office 365 TR-64
- Altın Üyelik Bitiş Tarihi
- 15-04-2025
Merhaba,
Aşağıdaki makro ay içinde çalışan personelleri listelemekte. Bu makroyu H3 - I3 hücrelerine gireceğim tarih aralığına göre listelemek olarak değiştirebilir misiniz.
Sub veri_al_Ay_ici_calisanlar()
Dim Sp As Worksheet, i As Long, sat As Long
Set Sp = Sheets("personel giriş-çıkışlar")
Application.ScreenUpdating = False
Application.Calculation = xlManual
Sheets("Günlük personel listesi").Select
Range("A6:AO" & Rows.Count).ClearContents
sat = 6
For i = 9 To Sp.Cells(Rows.Count, "C").End(xlUp).Row
If Sp.Cells(i, "E") <= DateSerial(Year([E1]), Month([E1]) + 1, 0) Then
If Sp.Cells(i, "F") = "" Or _
Sp.Cells(i, "F") >= CDate("1." & Month([E1]) & "." & Year([E1])) Then
Sp.Cells(i, "B").Resize(1, 5).Copy Cells(sat, "B")
Cells(sat, "A") = sat - 5
If Sp.Cells(i, "F") > [I4] Then Cells(sat, "F").ClearContents
sat = sat + 1
End If
End If
Next i
Range("R1:AO1").Copy Range("R6:AO" & sat - 1)
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Aşağıdaki makro ay içinde çalışan personelleri listelemekte. Bu makroyu H3 - I3 hücrelerine gireceğim tarih aralığına göre listelemek olarak değiştirebilir misiniz.
Sub veri_al_Ay_ici_calisanlar()
Dim Sp As Worksheet, i As Long, sat As Long
Set Sp = Sheets("personel giriş-çıkışlar")
Application.ScreenUpdating = False
Application.Calculation = xlManual
Sheets("Günlük personel listesi").Select
Range("A6:AO" & Rows.Count).ClearContents
sat = 6
For i = 9 To Sp.Cells(Rows.Count, "C").End(xlUp).Row
If Sp.Cells(i, "E") <= DateSerial(Year([E1]), Month([E1]) + 1, 0) Then
If Sp.Cells(i, "F") = "" Or _
Sp.Cells(i, "F") >= CDate("1." & Month([E1]) & "." & Year([E1])) Then
Sp.Cells(i, "B").Resize(1, 5).Copy Cells(sat, "B")
Cells(sat, "A") = sat - 5
If Sp.Cells(i, "F") > [I4] Then Cells(sat, "F").ClearContents
sat = sat + 1
End If
End If
Next i
Range("R1:AO1").Copy Range("R6:AO" & sat - 1)
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub