Personel Listemde Geç kalan ve gelmeyenlerin isimleri belirleme

[TASADAM366]

İyi geceler excelweb ailesi.Yukarıda iki resimsize gönderdiğim excel dosyasından çekilmiştir.Biraz açıklama yapayım.tabloda
1 değeri o personelin işe zamanında geldiğini
2 değeri işe geç kaldığını
0 değeri ise işe gelmediğini sembolize etmektedir.
Benim istediğim şu.
Örneğin Pazartesi günü
İşe geç kalan personellerin isimleri belirlenip(2 geçen hücreleri bulup) D42 hücresine yazılsın
İşe gelmeyenlerin yine isimleri belirlenip(0 değeri geçen hücreleri) D41 hücresine yazılsın.
Bu diğer 5 gün içinde uygulansın.
Gelenlere gerek yoktur.
Mümkünse makrosuz yapınız.Değilse makroyu bana açıklayınız.Zira asıl belgeme uygulamak zor oluyor bana acemiliğimden dolayı...
İlginiz ve yardımlarınız için şimdiden teşekkür ederim.Saygılarımla

 

[muygun]

Merhaba;
Eki inceleyin.
İyi çalışmalar.

 

[Necdet]

Merhaba,

Bu da makrolu alternatif çözüm olsun.

Aşağıdaki kodlar bir modüle kopyalayıp deneyebilirsiniz.
Son 2 satır (gelmeyen ve geç kalanlar) olmasa bile bu iki satırı ekler (Kenarlıklar ve işin süsü hariç)

Dolayısıyla personel sayısı ile sınırlı değildir.

Sub Listele()
 
    Dim i               As Integer
    Dim j               As Integer
    Dim Sat_Gelmeyen    As Integer
    Dim Sat_Gec_Kalan   As Integer
    Dim SonSat          As Integer
    Dim c               As Range
    
    Application.ScreenUpdating = False
    
    Set c = Range("a:a").Find("GELMEYEN", LookIn:=xlValues)
    
    If Not c Is Nothing Then
        Sat_Gelmeyen = c.Row
        Sat_Gec_Kalan = Sat_Gelmeyen + 1
    Else
        Sat_Gelmeyen = Cells(Rows.Count, "B").End(3).Row + 1
        Sat_Gec_Kalan = Sat_Gelmeyen + 1
        Cells(Sat_Gelmeyen, "A") = "GELMEYEN (0)"
        Cells(Sat_Gec_Kalan, "A") = "İŞE GEÇ KALAN (2)"
    End If
    Range("D" & Sat_Gelmeyen & ":I" & Sat_Gec_Kalan).ClearContents
    
    For i = 6 To Sat_Gelmeyen - 1
        For j = 4 To 9
            If Cells(i, j) = 0 Then
                If Len(Cells(Sat_Gelmeyen, j)) = 0 Then
                    Cells(Sat_Gelmeyen, j) = Cells(i, "C")
                Else
                    Cells(Sat_Gelmeyen, j) = Cells(Sat_Gelmeyen, j) & Chr(10) & Cells(i, "C")
                End If
            ElseIf Cells(i, j) = 2 Then
                If Len(Cells(Sat_Gec_Kalan, j)) = 0 Then
                    Cells(Sat_Gec_Kalan, j) = Cells(i, "C")
                Else
                    Cells(Sat_Gec_Kalan, j) = Cells(Sat_Gec_Kalan, j) & Chr(10) & Cells(i, "C")
                End If
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "Listeleme Bitmiştir....", vbInformation, "N. YEŞERTENER"
    
End Sub

 

[TASADAM366]

muygun ilginiz ve yardımlarınız için teşekkür ederim.İstediğim bu değildi.Ama yine de teşekkürü fazlasıyla hak ediyorsunuz.Saygılarımla
Sayın Necdet Yeşertener,örneğinizi inceledim.Çok teşekkür ederim.Maalesef Makrolu olduğundan kendi asıl çalışmama uyarlayamadım.(Makro benim asıl excel dosyamada çalışıyor ama sadece 6 sutunda(D-I sutunları arasında))Ben çalışmamda 6 değil 185 sutun taranıyor.Ben makroyu kendi çalışmama ekleyip biraz kurdaladım ama başarısız oldum.Size yeni bir örnek göndersem makronuzu buna uyarlayabilir misiniz.Makronuzda geç kalan ve gelmeyenleri C44 ve C45 yazdırırsanız daha iyi olur.(Örnekte yeri hazır.)İlginiz ve yardımlarınız için teşekkür ederim.Saygılarımla

 

[Necdet]

Merhaba,

Önceki dosyada Gelmeyen ve geç kalan kişileri ilgili günün altında listeliyorduk.
Şimdi tek bir hücreye gellmeyenler ve geç gelenleri istiyorsunuz ama tüm günlerdekileri mi tek hücreye listelenecek?

Bu durumda bu listeleme anlamsız olmaz mı?

 

[TASADAM366]

Necdet Yeşertener size kolaylık olması açısından başka bir örnek göndereyim.Örnekte J1 sütüna bugünün tarihi girilmiş.Ve D6 W6aralığına da tarihler girilmiş.(Siz makronuzu yaparken GF sutununa kadar tarih gireleceğini varsayınız.)Makronun yapacağı j1 sutunundaki tarihi baz alıp o gün işe gelmeyen ve geç kalanları c44 ve c45 hücrelerinde göstermektir.Yani sadece bugüne ait geç kalan ve gelmeyenler gösterilecek.Saygılarımla

 

[Necdet]

Merhaba,

İlk yazdığım kodlardaki hevesim kaçtı. O yüzden listelenecek hücreyi sabit yaptım.

Personel sayısı arttığında kodlarda gereken değişiklikleri yapınız.

Umarım yeni birşey eklemezseniz, öyle değil böyle idi diye.

Sub Listele()
    
    Dim c   As Range
    Dim i   As Integer
    Dim Kol As Integer
    
    Set c = Range("6:6").Find(Range("J1"), LookIn:=xlFormulas)
    If Not c Is Nothing Then
        Kol = c.Column
    Else
        MsgBox "İlgili Tarihi Bulamadım.......", vbCritical, "HATALI DURUM"
        Exit Sub
    End If
    i = 7
    
    Application.ScreenUpdating = False
    
    Range("C45:C46") = ""
    
    Do
        If Cells(i, Kol) = 2 Then
            If Len(Range("C45")) = 0 Then
                Range("C45") = Cells(i, "C")
            Else
                Range("C45") = Range("C45") & ", " & Cells(i, "C")
            End If
        ElseIf Cells(i, Kol) = 0 Then
            If Len(Range("C46")) = 0 Then
                Range("C46") = Cells(i, "C")
            Else
                Range("C46") = Range("C46") & ", " & Cells(i, "C")
            End If
        End If
        i = i + 1
    Loop Until Cells(i, "C") = ""
    Application.ScreenUpdating = True
    
    MsgBox "Listeleme Bitmiştir........", vbInformation, "N. YEŞERTENER"
    
End Sub

 

[irfangursoy]

personel listeyi yapmak istiyorum şubeler göre yardım!!

derdimi buraya yazmayı uygun gördüm.belki diğer arkadaşlara da yardımı olur diye. benim problemim şudur.
1.sayfada şubelerim ve bilgileri var.
2.sayfada tüm personel bilgilerim var.(hangi şubede çalıştıkları dahil)
3.sayfa =indis fonksiyonu ile istediğim bilgileri getiriyorum fakat
birinici indis fonksiyonunda şubeyi seçtikten sonra ikinci fonksiyonda tüm personel bilgileri geliyor. benim istediğim birincide şubeyi seçtikten sonra ikincide sadece o şubenin çalışanlarını görmek. bunu bir türlü beceremedim.forumuda araştırdım ama patronum artık facebook ta yada tweeter damı takılıyon dedi.. acil yardımlarınızı bekliyorum.. bu arada office 2007 var..
şimdiden teşekkürler..