Vardiya raporunda aktarma işlemi

[ersoyalan]

Uzman arkadaşlarım.

Yapmak istediğim vardiya raporunda 08:45 - 19:45'den sonraki girişleri aktar sayfasına belirtilmiş hücrelere butonla aktarmak.

08:45 ve 19:45'den önceki girişlerin ise gene belirtilmiş olan hücrelere aktarımı.


Konu hakkında yardımcı olursanız sevinirim.

Syg,

E.ALAN

 

[Ferhat Pazarçevirdi]

Commandbutton'un Click olayını aşağıdaki gibi kodlaynız.

Option Explicit
Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim col As Integer
    Dim str As Integer
    
    Application.Calculation = xlCalculationManual
    
    On Error GoTo fpc
    
    With UsedRange
        Range("A4:N" & .Row + .Cells.Count).ClearContents
    End With
    
    With Sheets("EASON NISAN")
        
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            
            If IsDate(.Cells(i, 1)) Then
                
                Select Case TimeSerial(Hour(.Cells(i, 1)), _
                                       Minute(.Cells(i, 1)), _
                                       Second(.Cells(i, 1)))
                    
                    Case Is < #8:45:00 AM#: col = 1
                    Case #8:45:00 AM# To #7:45:00 PM#: col = 6
                    Case Is > #7:45:00 PM#: col = 11
                
                End Select
                
                str = Cells(65536, col).End(xlUp).Row + 1
                
                Cells(str, col) = .Cells(i, 10)
                Cells(str, col + 1) = .Cells(i, 7)
                Cells(str, col + 2) = .Cells(i, 1)
                Cells(str, col + 3) = .Cells(i, 6)
            
            End If
        
        Next i
    
    End With
    
fpc:
    
    Application.Calculation = xlCalculationAutomatic
    
End Sub

 

[ersoyalan]

Hocam çok teşekkürderim.Ellerine sağlık tam istediğim gibi olmuş..

Kolay gelsin,

iyi çalışmalar.

E.ALAN

 

[ersoyalan]

Hocam tekrar merhaba,

Vardiyada birden fazla giriş çıkış oluyor.Bana yapmış olduğunuz örnekten hariç birde şu şekilde yardımcı olurmusunuz..

04/09/2008 tarihinde birden fazla giriş çıkış yapılmış.Bana ilk kart okutuluş saati gerekli...

Bana bir aylık vardiyada ilk kart okutuş saatleri yani 08:45 - 09:30 - 19:45 -20:30 arasındaki girişler gerekli..

 

[ersoyalan]

Ferhat ustam son isteğime bakmanız mümkünmü?

 

[Ferhat Pazarçevirdi]

Bana bir aylık vardiyada ilk kart okutuş saatleri yani 08:45 - 09:30 - 19:45 -20:30 arasındaki girişler gerekli..

Bu kısmı anlayamıyorum. Eğer 08:45 ila 09:30 arası ve 19:45 ila 20:30 arasındaki iki aralıkta yapılan ilk girişler diyorsanız aşağıdaki kodu kullanın.

Ama bazı günler, bu iki aralığa denk gelen hiçbir giriş çıkış yok bilesiniz.

Option Explicit
Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim str As Integer
    Dim y As Integer
    Dim x As Integer
    Dim saat As Date
    
    Application.Calculation = xlCalculationManual
    
    On Error GoTo fpc
    
    With UsedRange
        Range("A4:N" & .Row + .Cells.Count).ClearContents
    End With
    
    With Sheets("EASON NISAN")
        
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            
            If IsDate(.Cells(i, 1)) Then
                
                
                saat = CDate(Format(.Cells(i, 1), "hh:mm:ss"))
                
                If (saat >= #8:45:00 AM# And saat <= #9:30:00 AM#) Or _
                    saat >= #7:45:00 PM# And saat <= #8:30:00 PM# Then
                    
                    str = Cells(65536, 3).End(xlUp).Row + 1
                
                    For x = 4 To str
                        If Format(Cells(x, 3), "dd.mm.yy") = Format(.Cells(i, 1), "dd.mm.yy") Then
                            y = y + 1
                        End If
                    Next x
                    
                    If y = 0 Then
                        Cells(str, 1) = .Cells(i, 10)
                        Cells(str, 2) = .Cells(i, 7)
                        Cells(str, 3) = .Cells(i, 1)
                        Cells(str, 4) = .Cells(i, 6)
                    End If
                    y = 0
                End If
        
            End If
        Next i
    
    End With
    
fpc:
    
    Application.Calculation = xlCalculationAutomatic
    
End Sub

 

[ersoyalan]

Ferhat hocam yardımlarınız için çok teşekkürderim..Gecikmeli cevap yazdım farkındayım fakat sebebim vardı...
Bu Cuma günü sabah saat :10:55'de kızım oldu..Hastanedeydim Allahıma şükürler olsunki kızımda ve eşimde hiç bir sağlık sorunu yok..Çok mutluyum bu sebepden dolayı siz saygı değer grup arkadaşlarımdan biraz uzak kalıcam.Kendinize çok iyi bakın Allaha emanet olun..Hoşcakalın...

Syg,
E.ALAN

 

[Ferhat Pazarçevirdi]

Ferhat hocam yardımlarınız için çok teşekkürderim..Gecikmeli cevap yazdım farkındayım fakat sebebim vardı...
Bu Cuma günü sabah saat :10:55'de kızım oldu..Hastanedeydim Allahıma şükürler olsunki kızımda ve eşimde hiç bir sağlık sorunu yok..Çok mutluyum bu sebepden dolayı siz saygı değer grup arkadaşlarımdan biraz uzak kalıcam.Kendinize çok iyi bakın Allaha emanet olun..Hoşcakalın...

Syg,
E.ALAN

Bütün gecikmeler, inşallah, bu kadar güzel bir sebepten olur ...

Tebrik ediyorum. Allah analı babalı büyütsün. Bahtını, talihini açık etsin. Vatanına, milletine hayıtlı bir evlat olsun.