KOŞULA BAĞLI SAAT VERİSİ GETİRME

[bkk]

Merhabalar,

Ekte bulunan Excel kitabındaki verileri baz alarak(tarih, giriş-çıkış kaydı, kullanıcı ve proje koşuluna göre) özet sekmesine saat verisi çekmek istiyorum,
Konu hakkında yardımcı olabilir misiniz,

Teşekkür ederim,

 

[ÖmerFaruk]

Hücre biçimlendirmelerini yapmadım.

Sub Özet()
    Dim Sh1 As Worksheet, Sh2 As Worksheet, Veri As Variant, Say As Integer
    Set Sh1 = Worksheets("ANAVERİ")
    Set Sh2 = Worksheets("ÖZET")
    Son = Sh1.Range("B1").End(xlDown).Row
    MinTarih = WorksheetFunction.Min(Sh1.Range("G:G"))
    MaxTarih = WorksheetFunction.Max(Sh1.Range("G:G"))
    Veri = Sh1.Range("A1").CurrentRegion.Value
    ReDim Liste(1 To 1 + UBound(Veri), 1 To 4 + 2 * (MaxTarih - MinTarih))
    For i = 3 To UBound(Veri) Step 2
        Liste(1, i) = MinTarih + i - 3
        Liste(1, i + 1) = MinTarih + i - 3
        Liste(2, i) = "Giriş Kaydı"
        Liste(2, i + 1) = "Çıkış Kaydı"
    Next i
    Liste(2, 1) = "PROJE"
    Liste(2, 2) = "KULLANICI"
    For i = 2 To UBound(Veri)
        Liste(i + 1, 1) = Veri(i, 2)
        Liste(i + 1, 2) = Veri(i, 5)
        Say = (Veri(i, 7) - MinTarih) * 2 + InStr(1, Veri(i, 3), "Çıkış")
        Liste(i + 1, Say + 3) = Veri(i, 8)
    Next i
    Sh2.Cells.ClearContents
    Sh2.Range("A1").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
End Sub

 

[bkk]

Merhabalar,
Teşekkür ediyorum dönüşünüz ve emeğiniz için,
bir sorum olacaktı; Aynı kullanıcı aynı proje aynı gün koşulunun giriş ve çıkışlarını ayrı satırda değil de yan yana hücrede yazmak mümkün müdür

 

[ÖmerFaruk]

Tablo örneğini paylaşır mısınız?

 

[bkk]

aşağıdaki gibi;

		12.09.2022​	12.09.2022​	13.09.2022​	13.09.2022​
PROJE	KULLANICI	Giriş Kaydı	Çıkış Kaydı	Giriş Kaydı	Çıkış Kaydı
X	kullanıcı1	07:07	08:10
Y	kullanıcı2			08:15	08:10

 

[Ziynettin]

Alternatif çalışma,

Sub test()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long
    Dim i As Long, j As Integer, krt As String
    Dim a(), b(), dc As Object, dt As Object, ds As Object, dz As Object
    Set S1 = Worksheets("ANAVERİ")
    Set S2 = Worksheets("ÖZET")
    Son = S1.Range("B" & Rows.Count).End(3).Row
    a = S1.Range("B1:H" & Son).Value
    
    Set dc = CreateObject("scripting.dictionary")
    Set dt = CreateObject("scripting.dictionary")
    Set ds = CreateObject("scripting.dictionary")
    Set dz = CreateObject("scripting.dictionary")
    
    For i = 2 To UBound(a)
        dc(a(i, 1) & "|" & a(i, 4)) = ""
        dt(a(i, 6)) = ""
        ds(a(i, 2)) = ""
        krt = a(i, 1) & "|" & a(i, 4) & "|" & a(i, 6) & "|" & a(i, 2)
        dz(krt) = a(i, 7)
    Next i

    ReDim b(1 To dc.Count + 2, 1 To (dt.Count * 2) + 2)
    b(2, 1) = "PROJE"
    b(2, 2) = "KULLANICI"
    For j = 0 To dt.Count - 1
        b(1, (j * 2) + 3) = dt.keys()(j)
        b(1, (j * 2) + 4) = dt.keys()(j)
        b(2, (j * 2) + 3) = "Giriş Kaydı"
        b(2, (j * 2) + 4) = "Çıkış Kaydı"
    Next j
    
    Say = 2
    For i = 0 To dc.Count - 1
    Say = Say + 1
    b(Say, 1) = Split(dc.keys()(i), "|")(0)
    b(Say, 2) = Split(dc.keys()(i), "|")(1)
        For j = 1 To (dt.Count * 2)
            krt = dc.keys()(i) & "|" & b(1, j + 2) & "|" & b(2, j + 2)
            If dz.exists(krt) Then
                b(Say, j + 2) = dz(krt)
            End If
        Next j
    Next i
    S2.Cells.ClearContents
    S2.[A1].Resize(Say, (dt.Count * 2) + 2) = b
    S2.[C3].Resize(Say, (dt.Count * 2)).NumberFormat = "hh:mm"
    S2.[C1].Resize(, (dt.Count * 2)).NumberFormat = "dd.mm.yyyy"
    MsgBox "İşlem tamam...", vbInformation
End Sub

 

[Korhan Ayhan]

Özet tablo ile alternatif...

 

[ÖmerFaruk]

Ben sorunuzu eksik okumuşum. Kusura bakmayın.
Ziynettin beyin kodları sanırım işinizi çözecek. Gayet hızlı sonuç üretiyor.
Korhan beyde Özet tablo ile çözüm sunmuş.

Eğer Verilerinizin format ve içeriği verilen yöntemlere doğru sonuç üretiyorsa sanırım bir şey yapmama gerek yok.

 

[bkk]

Ayrı ayrı çok teşekkür ediyorum,