• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Personel Giriş Çıkış Saatleri

  • Konbuyu başlatan Konbuyu başlatan SER973
  • Başlangıç tarihi Başlangıç tarihi
S

SER973

Altın Üye
Katılım
3 Mart 2005
Mesajlar
84
Excel Vers. ve Dili
Excel-2007
Saygı değer Arkadaşlar

Personel Giriş ve Çıkışlarının Kayıt edildiği bir tablo var Bu Tabloda Personelin Her Hareketi (Giriş-Çıkışı) Tek bir veri satırı olarak karışık kayıt ediliyor. Ben Ayrı bir safyada Bunları ekteki tablodaki listelemem gerekiyor. Bunu Fonsiyonlarla başardım. Ancak Formül satırları uzun olduğundan bir veri değiştiğinde çok uzun süre bekliyorum. Acaba VBA-Makroda Yapmak mümkünmüdür.

Şimdiden Teşekürler...
 
Biraz uğraşalım bakalım. :)

Öncelikle sizden birkaç bilgi öğrenmemiz gerekecek.

1-Mutlaka her tarih seçtiğinizde tüm personellerin listesi mi ekrana gelecek?
Yoksa sadece kart okutanların ki mi?

2-Bir kişi bir günde en fazla 2 adet mi kart okutması olabilir?Yoksa daha fazla olabilir mi?

3-Kart okutma bilgilerini herhangi bir programdan mı alıyorsunuz?Yoksa manuel mi giriyorsunuz?

Şu anda bu kadar.
 
SN RİPEK

İlk önce İlginize Teşekkür ederim. Sormuş olduğunuz soruların cevapları aşağıdaki gibidir.

1-Tarih Seçildiğinde Tüm Personel Gelecek ( Personel Sayısı Artabilir veya azalabilir.)Kart Okutmayanlarda Belli olmalı...
2-Genelde 2 Kere Kart Okutulur ama 1-2 Saat izin alanlar Her Giriş çıkışında kart okutulur. (İlk Giriş Son Çıkış Alınmalı..)
3-Başka Bir Programndan Taboyu Standart Halde Kopyalıyorum. Bilgiler Başka Bir PC'de Ama Ağ bağlantısı yok...


Tekrar Tşk....
 
Aşağıdaki kodları sayfanın VBE bölümüne kopyalayarak deneyiniz.

Kod: 
[COLOR=blue]Private Sub[/COLOR] Worksheet_Change(ByVal [COLOR=blue]Target [/COLOR]As Range)
[COLOR=sienna][B]'www.excel.web.tr  Ripek[/B][/COLOR]
'12/01/2008 Cumartesi
[COLOR=blue]'*******************************************[/COLOR]
On Error Resume Next
If Intersect(Target, [c4]) Is Nothing Then Exit Sub
[COLOR=blue]Dim [/COLOR]a, b, c, i, n, veri1(), veri2()
[COLOR=blue]Dim[/COLOR] sectar As Date
[COLOR=blue]Dim[/COLOR] durum As Boolean
[COLOR=blue]Set[/COLOR] s1 = Sheets("Data")
[COLOR=blue]Set[/COLOR] s2 = Sheets("Personel")
[COLOR=blue]Set[/COLOR] s3 = Application.ActiveSheet
sectar = s3.Range("c4")
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]'*******************************************[/COLOR]
a = s2.Range("b6:c" & s2.[b65536].End(3).Row).Value
b = s1.Range("a2:k" & s1.[a65536].End(3).Row).Value
[COLOR=blue]ReDim [/COLOR]veri1(1 To [COLOR=blue]UBound[/COLOR](a, 1) + [COLOR=blue]UBound[/COLOR](b, 1), 1 To 9)
With [COLOR=blue]CreateObject("Scripting.Dictionary")[/COLOR]
    .CompareMode = vbTextCompare
    For i = 1 To [COLOR=blue]UBound[/COLOR](a, 1)
    durum = [COLOR=blue]False[/COLOR]
        For j = 1 To [COLOR=blue]UBound[/COLOR](b, 1)
        If [COLOR=blue]CDate[/COLOR](b(j, 8)) =[COLOR=blue] CDate[/COLOR](sectar) [COLOR=blue]And[/COLOR] a(i, 1) = b(j, 2) Then
         z = b(j, 2) & ":" & b(j, 8) & ":" & b(j, 9)
               If Not [COLOR=blue]IsEmpty[/COLOR](z) And Not .exists(z) Then
                    n = n + 1
                    veri1(n, 1) = n
                    veri1(n, 2) = Format(b(j, 8), "dd.mm.yyyy")
                    veri1(n, 3) = b(j, 2)
                    veri1(n, 4) = b(j, 4)
                    veri1(n, 5) = ""
                    veri1(n, 6) = "NORMAL"
                    veri1(n, 7) = b(j, 9)
                    .Add z, n
                    durum = [COLOR=blue]True[/COLOR]
                   End If
                End If
         Next j
        If durum = [COLOR=blue]False[/COLOR] Then
            n = n + 1
            veri1(n, 1) = n
            veri1(n, 2) = Format(sectar, "dd.mm.yyyy")
            veri1(n, 3) = a(i, 1)
            veri1(n, 4) = a(i, 2)
            veri1(n, 5) = ""
            veri1(n, 6) = "NORMAL"
            veri1(n, 7) = ""
        End If
    Next i
End With
[COLOR=blue]'*******************************************[/COLOR]
If n > 0 Then
Son = s3.[a65536].End(3).Row + 1
s3.Range(Cells(9, "a"), Cells(Son, "L")).ClearContents
s3.[a9].Resize(n, 8).Value = veri1
Else
MsgBox "Kayıt Bulunamadı.", vbInformation, "Bilgi"
GoTo Kapat:
End If
n = 0
[COLOR=blue]'*******************************************[/COLOR]
c = s3.Range("b9:g" & s3.[b65536].End(3).Row).Value
ReDim veri2(1 To [COLOR=blue]UBound[/COLOR](c, 1), 1 To 12)
    With [COLOR=blue]CreateObject("Scripting.Dictionary")[/COLOR]
        For i = 1 To [COLOR=blue]UBound[/COLOR](c, 1)
        z = c(i, 1) & ":" & c(i, 2)
            If Not .exists(z) Then
                n = n + 1
                veri2(n, 1) = n
                veri2(n, 2) = Format(c(i, 1), "dd.mm.yyyy")
                veri2(n, 3) = c(i, 2)
                veri2(n, 4) = c(i, 3)
                veri2(n, 5) = ""
                veri2(n, 6) = "NORMAL"
                .Add z, Array(n, 7)
            End If
            w = .Item(z)
            veri2(w(0), w(1)) = c(i, 6)
            w(1) = w(1) + 1
            .Item(z) = w
             Next i
    End With
[COLOR=blue]'*******************************************[/COLOR]
If n > 0 Then
Son = s3.[a65536].End(3).Row + 1
s3.Range(Cells(9, "a"), Cells(Son, "L")).ClearContents
s3.Range("a9").Resize(n, 12).Value = veri2
Else
MsgBox "Kayıt Bulunamadı.", vbInformation, "Bilgi"
End If
Application.ScreenUpdating = True
[COLOR=blue]'*******************************************[/COLOR]
Kapat:
[COLOR=blue]Set[/COLOR] s1 = [COLOR=blue]Nothing[/COLOR]
[COLOR=blue]Set [/COLOR]s2 = [COLOR=blue]Nothing[/COLOR]
[COLOR=blue]Set[/COLOR] s3 = [COLOR=blue]Nothing[/COLOR]
[COLOR=blue]End Sub[/COLOR]
 
Son düzenleme:
Sn. Ripek

Öncelikle Çalışmanız için çok teşekkür eder başarılı çalışmalarınızın devamını dilerim..
Yanlız Benim İstediğim Sadece Bir Sutun Giriş ve Bir Sütünda Çıkış olmalı idi. Aynı Tarihte 2 veya Daha Fazla Kart Basılması halinde GİRİŞ sütünuna İlk olanı (Küçüğünü) ÇIKIŞ sütününa ise Son olanı (Büyüğünü ) Yazması gerekiyor.
Kodları buna göre düzenlemek mümükün müdür..?

Birde Sizden Ricam VB Kod yazmaya nasıl başlamalıyım. Bir Kitap tavsiye edermisiniz. Zamanında Q Basic Görmüştüm. Ona Biraz Benziyor ama
Formu inceliyorum.. Güzel örnekler var ama.. Mesala Bir "On Error Resume Next","ReDim ....(1 To UBound(c, 1), 1 To 12)" Ne demek veya nerelerede kullanılabileceğimiz vs.vs. anlayamıyorum...

İLGİNİZE TEKRAR TEŞKKÜR EDERİM.....
 
SER973' Alıntı:
Sn. Ripek

Yanlız Benim İstediğim Sadece Bir Sutun Giriş ve Bir Sütünda Çıkış olmalı idi. Aynı Tarihte 2 veya Daha Fazla Kart Basılması halinde GİRİŞ sütünuna İlk olanı (Küçüğünü) ÇIKIŞ sütününa ise Son olanı (Büyüğünü ) Yazması gerekiyor.
Kodları buna göre düzenlemek mümükün müdür..?
.....
Genişletmek için tıkla ...

Bunu istediğinizi biliyorum.Fakat bunun üzerinde biraz çalışmak gerekiyor.Ayrıca buna değer mi bilmiyorum.
Çünkü aralardaki giriş çıkışlarda bazı zamanlar gerekli olabilir.

Diğer konuya gelince forumda bununla ilgili birçok başlık bulabilirsiniz.
 
evet arkadaşlar gerçekten çok önemli bir konu ama nedense bu konu hakkında elle tutulur bir çalışma bende bulamadım. sn. Ripek umarım bu konya çözüm bulur yapılan örnek işin önemli bir noktasını bitirmiş gibi ama asıl önemli nokta ise gece vardiyasında çözülüyor örneğin gece saat 23:00 giriş yapan birisi sabah 07:00 çıkış yaptığını düşünürsek tarih birgün artıyor. asıl can alıcı nokta burası umarım bu konuya sn.ripek çözüm bulur ve bu konuyla muzdarip olan arkadaşlar dertlerine çare bulur. saygılar
 
Dosyayı indiremiyoruz...

Arkadaşlar merhaba;

Ne yazık ki dosyayı indiremiyorum.. Dosyayı daha önce indirenler ayhanyazar@gmail.com adresine gönderebilirler mi?
 
Arkadaşlar kendinizi geliştirmek için uğraşıyorsanız çok güzel bişey ama yok exelle personel takip etmek istiyorsanız sizin için daha zor olacaktır.elimde basit ve kullanışlı bir program mevcut isteyene satabilirim.ücret kolay
 
Dosya indirmeye çalıştığımda gift dosyası indiriyor. Farklı kaydet de işe yaramıyor
 
merhabalar ben burda yeniyim bende giriş ve çıkışlar için imza içerikli bir form hazırlamak istiyorum yardımcı olursanız sevinirim ve bende dosyayı göremeyenlerdenim herkese ii günler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst