Listeleme hk.

[nongeyikm]

Merhaba arkadaşlar,

Ekte amatörce bir çalışmam var. Amacım "günlük personel listesi" sayfasındaki E1 hücresine hangi tarihi girer isem, "Personel giriş çıkışlar" sayfasındaki verilerden faydalanarak o gün çalışmış olan personellerin listelenmesi. (çıkış tarihi rapor tarihin ile aynı gün ise listede yer almalı)

Ayrıca çalışmamın tamamına göz atıp düzeltme/iyileştirmeler var ise ilgilerinizi rica ederim.

Yardımlarınız için şimdiden teşekkür ederim.

 

[vardar07]

Deneyiniz.

 

[nongeyikm]

Sn. Vardar07,

Denedim fakat olmadı. Rapor tarihini 06.03.2017 yapıyorum, 6 sından sonraki işe girenler de listede yer alıyor. Ayın 6 sındaki sayım 23 olmalı. 7 sinde ise 21 olmalı (1 giriş, 3 çıkış). Ayrıca listeyi silip tekrar veri al dediğimde başlıkları da siliyor, A2 den itibaren listeliyor. Sizin için daha kolay olacaksa dilerseniz rapor tarihinin altında rapor bitiş tarihi şeklinde bir tarih daha koyarak ta listeleyebilirsiniz.

Saygılar,

 

[vardar07]

Aşağıdaki kod ile eskisini değiştirip denermisiniz.

Sub veri_al()
Set sp = Sheets("personel giriş-çıkışlar"): Set sg = Sheets("Günlük personel listesi")
sg.Range("A6:E" & sg.Range("A" & Rows.Count).End(3).Row + 1).ClearContents
Application.ScreenUpdating = False
For i = 9 To sp.Cells(Rows.Count, 2).End(3).Row
son = sg.Range("A" & Rows.Count).End(3).Row + 1
If sp.Cells(i, "F") = "" And sp.Cells(i, "E") <= sg.Cells(1, "E") Then
sg.Cells(son, 1) = WorksheetFunction.Max(sg.Range("A6:A" & son)) + 1
sp.Range("B" & i & ":E" & i).Copy sg.Cells(son, "B")
Else
If sp.Cells(i, "F") >= sg.Cells(1, "E") And sp.Cells(i, "E") <= sg.Cells(1, "E") Then
sg.Cells(son, 1) = WorksheetFunction.Max(sg.Range("A6:A" & son)) + 1
sp.Range("B" & i & ":E" & i).Copy sg.Cells(son, "B")
End If
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[nongeyikm]

Sn. Vardar7,

Personel bu gün işe girmiş ve de yarın işten çıkmış ise, bu günün raporunda yer almıyor.

Güzel bir gün dileğimle

 

[vardar07]

Üst mesajdaki (Kırmızılı > işareti)Düzeltmeyi yapıp deneyiniz.

 

[nongeyikm]

Çok özür dileyerek bir hatayı farkedemeden erken yanıt verdim.

10.03.2017 tarihini listelerken;

10.03.2017 tarihinden sonra işe girenlerde şayet çıkış tarihleri de var ise, bu personelleri de 10.03.2017 tarihli rapora ilave ediyor.

Saygılar,

 

[vardar07]

#4 Nolu mesajdaki kod güncellendi.

 

[nongeyikm]

Günaydın Sayın Vardar,

Şimdi de;

örneğin 15.03.2017 çalışan sayısı 55
fakat 15.03.2017 tarihinde 3 kişi işten ayrılmış
Makronuz sonucu 52 yapıyor.
Sonuç 55 olmalı.
Çünkü çıkış alan 3 kişi o gün çalışmış.

 

[vardar07]

Günaydın Sayın Vardar,
Şimdi de;
örneğin 15.03.2017 çalışan sayısı 55
fakat 15.03.2017 tarihinde 3 kişi işten ayrılmış
Makronuz sonucu 52 yapıyor.
Sonuç 55 olmalı.
Çünkü çıkış alan 3 kişi o gün çalışmış.

Örnek dosyanızda bahsettiğiniz veriler yok deneme şansım yok. Yukarıdaki kodu tekrar deneyiniz. olmadı ise demek ki sizin düşündüğünüzü ben düşünemiyorum. Anlayan var ise yardımcı olabilir.

 

[Ömer BARAN]

Merhaba.

Alternatif olsun.
Aşağıdaki dizi formülünü Günlük personel listesi sayfası B6 hücresine uygulayın ve
sağa ve boş sonuç elde edinceye kadar aşağı doğru kopyalayın.
.

=[COLOR="red"]EĞERHATA[/COLOR]([COLOR="red"]KAYDIR[/COLOR]([COLOR="darkorange"]'personel giriş-çıkışlar'![/COLOR]B$1;[COLOR="red"]KÜÇÜK[/COLOR]([COLOR="red"]EĞER[/COLOR]([COLOR="darkorange"]'personel giriş-çıkışlar'![/COLOR]$E$9:$E$67<=$E$1;[COLOR="red"]EĞER[/COLOR]([COLOR="red"]EĞER[/COLOR]([COLOR="darkorange"]'personel giriş-çıkışlar'![/COLOR]$F$9:$F$67="";[COLOR="red"]BUGÜN()[/COLOR];[COLOR="darkorange"]'personel giriş-çıkışlar'![/COLOR]$F$9:$F$67)>=$E$1;[COLOR="red"]SATIR[/COLOR]([COLOR="DarkOrange"]'personel giriş-çıkışlar'![/COLOR]$E$9:$E$67)));[COLOR="Red"]SATIR[/COLOR](B1))-1;0);"")
[COLOR="Blue"]Formül dizi formülü olduğundan hücreye [B][COLOR="red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden [COLOR="Red"]{....}[/COLOR][/B]  gibi köşeli parantez arasına alınır.[/COLOR]

Makro ile çözüm isterseniz;
-- Alt taraftan Günlük personel listesi sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağ taraftaki boş alana aşağıdaki kod'u yapıştırın,
-- A sütunundaki sıra numarası veren formülleri tamamen silin,
-- E1 hücresindeki tarihi elle değiştirin ve sonucu gözlemleyin.
.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [E1]) Is Nothing Then Exit Sub
Call PERSONEL_LISTESI
[B]End Sub

Sub PERSONEL_LISTESI()[/B]
Set l = Sheets("Günlük personel listesi")
Set p = Sheets("personel giriş-çıkışlar")
tarih = CDate(l.[E1])
If l.Cells(Rows.Count, 1).End(3).Row > 5 Then _
    l.Range("A6:E" & l.Cells(Rows.Count, 1).End(3).Row).ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For psat = 9 To p.Cells(Rows.Count, 1).End(3).Row
giriş = p.Cells(psat, "E"): çıkış = Date
If p.Cells(psat, "F") <> "" Then çıkış = p.Cells(psat, "F")
    If giriş <= tarih And çıkış >= tarih Then
    lsat = l.Cells(Rows.Count, 2).End(3).Row + 1
    l.Cells(lsat, 1) = lsat - 5
    p.Range("B" & psat & ":E" & psat).Copy
    l.Cells(lsat, "B").PasteSpecial Paste:=xlPasteValues
End If
Next
l.[E1].Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
If lsat = Empty Then MsgBox "Uygun tarih yazılmadı..."
If lsat > 6 Then MsgBox lsat - 5 & "  adet personel listelendi...", vbInformation, "..::.. Ö. BARAN ..::.."
[B]End Sub[/B]

 

[nongeyikm]

Gününüz aydın olsun Üstadlar,

Benim için harcadığınız zamanla ilgili sonsuz teşekkürler.

Sn. Vardar, hata sonrası size dönüşlerim, çok açıklayıcı ve de veri destekleyici olmadı hakısınız. Ama yine de anlayıp istediğim şekilde yapmışsınız. Allah razı olsun.

Ömer Bey,

Sizlere de sonsuz teşekkür. Sizin makronuz da doğru sonuç verdi. Tek sıkıntı sıra no yu 1 tane fazla koyuyor. Her ikinize de tekrar tekrar teşekkür. Mükemmelsiniz. Geçmişte ve halen excel.web.tr'yi var eden sizler sayesinde bir çok iş yükünden kurtuldum.

Hayırlı günler diliyorum.