arge merkezi içeride kalınan sürelerin toplamı hk.

nuriogden

nuriogden

Katılım
11 Eylül 2019
Mesajlar
16
Excel Vers. ve Dili
office 2019
Altın Üyelik Bitiş Tarihi
20-09-2024
iç olan giriş saati dış olan çıkış saati olmalı. son birde kart numarası ile isimleri eşleştirme yapabilirmiyiz. mesela bazen sadece kart numarası geliyor rapor aldığımda bunun yanına isimi hangi kart numarası kimde ise otomatik atabilirmi
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Öncelikle eski dosyadaki sonuçlar sayfasını kopya olarak yeni dosyanıza taşıyın (iki dosyada açıkken sayfa adına sağ tık, taşı veya kopyala, üstten yeni dosyayı seçip alttan kopya oluşturu işaretleyerek işlemi tamamlayın).

Makro olarak aşağıdaki kodları yeni dosyanızda bir modüle kopyalayıp deneyin:

PHP: 
Sub argeciler()
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("sonuçlar")
    son1 = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
    son2 = WorksheetFunction.Max(3, s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "G").End(3).Row)

    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("B2:B" & son1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s1.Sort.SortFields.Add Key:=Range("A2:A" & son1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With s1.Sort
        .SetRange Range("A1:I" & son1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    sonB = s1.Cells(Rows.Count, "B").End(3).Row
    s2.Range("A3:M" & son2) = ""
    For i = 2 To sonB
        If s1.Cells(i, "I") = "İÇ" Then
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row + 1, s2.Cells(Rows.Count, "G").End(3).Row + 1)
            s2.Cells(yeni, "A") = s1.Cells(i, "A")
            s2.Cells(yeni, "B") = s1.Cells(i, "C")
            s2.Cells(yeni, "C") = s1.Cells(i, "D")
            s2.Cells(yeni, "D") = s1.Cells(i, "E")
            s2.Cells(yeni, "E") = s1.Cells(i, "F")
        Else
            giris = s2.Cells(Rows.Count, "A").End(3).Row
            cikis = s2.Cells(Rows.Count, "G").End(3).Row
            If cikis >= giris Then giris = cikis + 1
'            If s2.Cells(giris, "B") <> s1.Cells(i, "C") Then giris = giris + 1
            s2.Cells(giris, "G") = s1.Cells(i, "A")
            s2.Cells(giris, "H") = s1.Cells(i, "C")
            s2.Cells(giris, "I") = s1.Cells(i, "D")
            s2.Cells(giris, "J") = s1.Cells(i, "E")
            s2.Cells(giris, "K") = s1.Cells(i, "F")
        End If
                
    Next
    sonA = s2.Cells(Rows.Count, "A").End(3).Row
    sonG = s2.Cells(Rows.Count, "G").End(3).Row
    For j = 3 To WorksheetFunction.Max(3, sonA, sonG)
        If s2.Cells(j, "B") = s2.Cells(j, "H") Then
            s2.Cells(j, "M").FormulaR1C1 = "=RC[-6]-RC[-12]"
        ElseIf s2.Cells(j, "A") = "" Then
            s2.Cells(j, "M") = "Giriş yok"
        ElseIf s2.Cells(j, "G") = "" Then
            s2.Cells(j, "M") = "Çıkış Yok"
        Else
            s2.Cells(j, "M") = "İsimler Farklı"
        End If
    Next
    [P:Q] = ""
    s2.[P1] = "Adı Soyadı"
    s2.[Q1] = "Toplam İçerde Kalma Süresi"
    [P1:Q1].Font.Bold = True
    s2.Range("B3:B" & giris).Copy s2.[P2]
    Application.CutCopyMode = False
    s2.Range("$P$1:$P$" & giris).RemoveDuplicates Columns:=1, Header:=xlYes
    sonP = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "P").End(3).Row)
    For j = 2 To sonP
        s2.Cells(j, "Q") = WorksheetFunction.SumIf(s2.Range("B2:B" & giris), s2.Cells(j, "P"), s2.Range("M2:M" & giris))
    Next
    For p = sonP To 2 Step -1
        If s2.Cells(p, "P") = "" Then
            s2.Range("P" & p & ":Q" & p).Delete shift:=xlUp
        End If
    Next
    Range("Q2:Q" & sonP).NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Range("P2:Q" & sonP).VerticalAlignment = xlCenter
    Range("Q2:Q" & sonP).HorizontalAlignment = xlCenter
    Range("1:19").EntireColumn.AutoFit
End Sub
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
İsim ekleme işlemi için kodu güncelledim:

PHP: 
Sub argeciler()
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("sonuçlar")
    son1 = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
    son2 = WorksheetFunction.Max(3, s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "G").End(3).Row)

    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("B2:B" & son1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s1.Sort.SortFields.Add Key:=Range("A2:A" & son1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With s1.Sort
        .SetRange Range("A1:I" & son1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    sonB = s1.Cells(Rows.Count, "B").End(3).Row
    For k = 2 To sonB
        If s1.Cells(k, "C") = "" Then
            For m = 2 To sonB
                If s1.Cells(m, "B") = s1.Cells(k, "B") And s1.Cells(m, "C") <> "" Then
                    s1.Cells(k, "C") = s1.Cells(m, "C")
                    m = sonB
                End If
            Next
        End If
    Next
    s2.Range("A3:M" & son2) = ""
    For i = 2 To sonB
        If s1.Cells(i, "I") = "İÇ" Then
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row + 1, s2.Cells(Rows.Count, "G").End(3).Row + 1)
            s2.Cells(yeni, "A") = s1.Cells(i, "A")
            s2.Cells(yeni, "B") = s1.Cells(i, "C")
            s2.Cells(yeni, "C") = s1.Cells(i, "D")
            s2.Cells(yeni, "D") = s1.Cells(i, "E")
            s2.Cells(yeni, "E") = s1.Cells(i, "F")
        Else
            giris = s2.Cells(Rows.Count, "A").End(3).Row
            cikis = s2.Cells(Rows.Count, "G").End(3).Row
            If cikis >= giris Then giris = cikis + 1
'            If s2.Cells(giris, "B") <> s1.Cells(i, "C") Then giris = giris + 1
            s2.Cells(giris, "G") = s1.Cells(i, "A")
            s2.Cells(giris, "H") = s1.Cells(i, "C")
            s2.Cells(giris, "I") = s1.Cells(i, "D")
            s2.Cells(giris, "J") = s1.Cells(i, "E")
            s2.Cells(giris, "K") = s1.Cells(i, "F")
        End If
                
    Next
    sonA = s2.Cells(Rows.Count, "A").End(3).Row
    sonG = s2.Cells(Rows.Count, "G").End(3).Row
    For j = 3 To WorksheetFunction.Max(3, sonA, sonG)
        If s2.Cells(j, "B") = s2.Cells(j, "H") Then
            s2.Cells(j, "M").FormulaR1C1 = "=RC[-6]-RC[-12]"
        ElseIf s2.Cells(j, "A") = "" Then
            s2.Cells(j, "M") = "Giriş yok"
        ElseIf s2.Cells(j, "G") = "" Then
            s2.Cells(j, "M") = "Çıkış Yok"
        Else
            s2.Cells(j, "M") = "İsimler Farklı"
        End If
    Next
    [P:Q] = ""
    s2.[P1] = "Adı Soyadı"
    s2.[Q1] = "Toplam İçerde Kalma Süresi"
    [P1:Q1].Font.Bold = True
    s2.Range("B3:B" & giris).Copy s2.[P2]
    Application.CutCopyMode = False
    s2.Range("$P$1:$P$" & giris).RemoveDuplicates Columns:=1, Header:=xlYes
    sonP = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "P").End(3).Row)
    For j = 2 To sonP
        s2.Cells(j, "Q") = WorksheetFunction.SumIf(s2.Range("B2:B" & giris), s2.Cells(j, "P"), s2.Range("M2:M" & giris))
    Next
    For p = sonP To 2 Step -1
        If s2.Cells(p, "P") = "" Then
            s2.Range("P" & p & ":Q" & p).Delete shift:=xlUp
        End If
    Next
    Range("Q2:Q" & sonP).NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Range("P2:Q" & sonP).VerticalAlignment = xlCenter
    Range("Q2:Q" & sonP).HorizontalAlignment = xlCenter
    Range("1:19").EntireColumn.AutoFit
End Sub
 
nuriogden

nuriogden

Katılım
11 Eylül 2019
Mesajlar
16
Excel Vers. ve Dili
office 2019
Altın Üyelik Bitiş Tarihi
20-09-2024
çok tesekkur ederim emeğinize sağlık çok büyük bir dertti benim için :))
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst