Tarih aralığını listelemek

[nongeyikm]

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

 

[Necdet]

Merhaba,

Kodlardan bir şey anlamak olası değil, bir kaç tane koşul var, hangisinin ne olduğunu kodlara bakarak anlamak olası değil.
İki koşulun nasıl yazılacağını kodda belirttim
Gerekli değişiklikleri siz kendinize uyarlayınız.

H3 ve I3'ü hangi sayfaya yazdığınızı da belirtmemişsiniz, bunu da kodda dikkate almak gerekir.

Sub veri_al_Ay_ici_calisanlar()

    Dim Sp As Worksheet, i As Long, sat As Long
   
    Set Sp = Sheets("personel giriş-çıkışlar")
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
   
    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") >= Range("H3") And Sp.Cells(i, "E") <= Range("H3") 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)
   
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
   
End Sub

 

[nongeyikm]

Çok Teşekkür ederim.