Gelmeyenleri karşılaştırıp listeleme

[ercanyildiz]

Merhaba arkadaşlar;

Turnikeden sabah giriş yapan öğrencilerin dökümünü data sekmesindeki gibi alıyorum. Buradaki isimlerden 09:05 ten sonra giriş yapanların genel liste (LİSTE1) den kontrolü yapılarak giriş yapmayanların gelmeyenler sekmesinde listelenmesini istiyorum.

DÜŞEYARA kullanarak çok uğraştım,ancak başaramadım. Yardımcı olursanız çok sevinirim.

İyi çalışmalar.


https://dosya.co/r4vldmvv4ktr/TURNİKE.xlsx.html

 

[ÖmerBey]

Buradaki isimlerden 09:05 ten sonra giriş yapanların genel liste (LİSTE1) den kontrolü yapılarak giriş yapmayanların gelmeyenler sekmesinde listelenmesini istiyorum.

Merhaba,
Yukarıdaki bölümü anlayamadım. 9.05'ten sonra giriş yapanlar mı listelenecek yoksa hiç giriş yapmayanlar mı? Yada daha farklı bir şey mi istiyorsunuz.

 

[ercanyildiz]

Listelenecek kayıtlar, 09:05 ten sonra giriş yapanlar ve hiç giriş yapmayanlar.
09:05 e kadar giriş yapanlar gelmiş sayılıyor.

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kodu kullanabilirsiniz.

Kod, LİSTE1 sayfasındaki verilerin tümünü gelmeyenler sayfasına alır, data sayfasındaki saatler 09:05 ve öncesinde ise bunların satırları silinir.
Böylece gelmeyenler isimli sayfada sadece, 09:05'ten sonra gelmiş olanlar ve hiç gelmeyenler kalır.

Sub GECIKEN_GELMEYEN()
Set liste = Sheets("LİSTE1"): Set d = Sheets("data"): Set g = Sheets("gelmeyenler")
If g.Cells(Rows.Count, 1).End(3).Row > 1 Then g.Range("A2:D" & Rows.Count).ClearContents
ds = d.Cells(Rows.Count, 1).End(3).Row: ls = liste.Cells(Rows.Count, 1).End(3).Row:
gs = g.Cells(Rows.Count, 1).End(3).Row + 1
liste.Range("A2:C" & ls).Copy g.Cells(gs, 1): liste.Range("M2:M" & ls).Copy g.Cells(gs, 4)
For s = 2 To ds
    If TimeValue(d.Cells(s, 1)) <= TimeValue("09:05") Then
        gs = WorksheetFunction.Match(d.Cells(s, 2), g.[A:A], 0)
        g.Range("A" & gs & ":D" & gs).Delete Shift:=xlUp
    End If
Next: g.Range("A2:D" & ls).Sort g.[A1], 1: g.Columns.AutoFit
MsgBox "işlem tamamlandı...", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[halit3]

Alternatif kod:

Sub deneme1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("gelmeyenler").Range("A2:D" & Rows.Count).ClearContents

son = Worksheets("LİSTE1").Cells(Rows.Count, "A").End(3).Row

ReDim veri1(son)
baslangıc = CDate("09:05")


sat = 2
say1 = 0
For r = 2 To Worksheets("data").Cells(Rows.Count, "B").End(3).Row
If baslangıc < CDate(Format(Sheets("data").Cells(r, "a").Value, "hh:nn")) Then
Sheets("gelmeyenler").Cells(sat, 1).Value = Sheets("data").Cells(r, "b").Value
Sheets("gelmeyenler").Cells(sat, 2).Value = Sheets("data").Cells(r, "c").Value
Sheets("gelmeyenler").Cells(sat, 3).Value = Sheets("data").Cells(r, "d").Value
Sheets("gelmeyenler").Cells(sat, 4).Value = CDate(Format(Sheets("data").Cells(r, "a").Value, "hh:nn:ss"))
Sheets("gelmeyenler").Cells(sat, 4).NumberFormat = "hh:mm:ss"
sat = sat + 1
End If

say1 = say1 + 1
veri1(say1) = Val(Sheets("data").Cells(r, "b").Value)
Next r

For i = 2 To Worksheets("LİSTE1").Cells(Rows.Count, "B").End(3).Row
aranan = Val(Sheets("LİSTE1").Cells(i, "a").Value)

For j = 1 To say1
If aranan = veri1(j) Then
GoTo atla
End If
Next j

Sheets("gelmeyenler").Cells(sat, 1).Value = Sheets("LİSTE1").Cells(i, "a").Value
Sheets("gelmeyenler").Cells(sat, 2).Value = Sheets("LİSTE1").Cells(i, "b").Value
Sheets("gelmeyenler").Cells(sat, 3).Value = Sheets("LİSTE1").Cells(i, "c").Value
Sheets("gelmeyenler").Cells(sat, 4).Value = Sheets("LİSTE1").Cells(i, "m").Value
Sheets("gelmeyenler").Cells(sat, 4).NumberFormat = "General"
sat = sat + 1
atla:

Next i

MsgBox "işlem tamam"
End Sub

 

[ÖmerBey]

Aşağıdaki kodu bir deneyin.
Önce geç gelenleri sonra hiç gelmeyenleri yazdırır.
(Kodu dün yazmıştım ama siteye yükleyemedim. Cevaplar çoktan gelmiş, ama boşa gitmesin, alternatif olsun.)

Sub kod()
Dim a As Integer, x As Integer
Dim L As Worksheet, D As Worksheet, G As Worksheet
Set L = Sheets("LİSTE1")
Set D = Sheets("data")
Set G = Sheets("gelmeyenler")
G.Range("A2:D" & Rows.Count).ClearContents
x = 2
For a = 2 To D.Cells(Rows.Count, 1).End(3).Row
    If TimeValue(D.Cells(a, 1)) > TimeValue("09:05:59") Then
        G.Cells(x, 1).Resize(, 3).Value = D.Cells(a, 2).Resize(, 3).Value
        G.Cells(x, 4) = L.Range("A:A").Find(D.Cells(a, 2), lookat:=xlWhole).Offset(0, 12).Value
        x = x + 1
    End If
Next
x = x + 1
For a = 2 To L.Cells(Rows.Count, 1).End(3).Row
    If WorksheetFunction.CountIf(D.Range("B:B"), L.Cells(a, 1)) = 0 Then
        G.Cells(x, 1).Resize(, 3).Value = L.Cells(a, 1).Resize(, 3).Value
        G.Cells(x, 4).Value = L.Cells(a, "M").Value
        x = x + 1
    End If
Next
MsgBox "İşlem tamam"
End Sub