Sayfalar Arasındaki Kullanıcı Sürelerini Toplama

[noartist]

Merhaba Arkadaşlar,

Linkteki makro dosyasında ActiveTime sayfasında B stunundaki kullanıcıya ait zamanları toplayıp, Rapor sayfasındaki Active Time alanına kullanıcıya ait toplamı yazması gerekiyor.
Ayrıca Total Time sayfasında C stunundaki kullanıcıya ait datayıda toplayıp Rapor sayfasında Total Time alanına toplamı yazması gerekiyor, aradaki farkı Rapor sayfasındaki Aradaki Fark bölümüne yazmasını için yardımlarınızı rica ederim.

Linkteki dosya daha önce bu işlemi yaptığım makro içermektedir, sadece değişiklikler yapılması gerekiyor.

https://wetransfer.com/downloads/9ad36f1fe9ba5783490d3c58328f8b4020191003220825/0b3600

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Pivot_Table()
    Dim S1 As Worksheet, Sh As Worksheet, Kullanici As String
    Dim Son As Long, X As Long, Saat As Byte, Dakika As Byte, Saniye As Byte
    Dim Zaman As Variant, Y As Byte, Bul As Range
    Dim Kullanici_Sutunu As Byte, Zaman_Sutunu As Byte, Kayit_Sutunu As Byte
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("Rapor")

    S1.Range("E2:F" & S1.Rows.Count).ClearContents
    S1.Range("E2:F" & S1.Rows.Count).NumberFormat = "[hh]:mm:ss"
    
    For Each Sh In ThisWorkbook.Worksheets
                
        If Sh.Name = "TotalTime" Then
            Kullanici_Sutunu = 2
            Zaman_Sutunu = 3
            Kayit_Sutunu = 5
        ElseIf Sh.Name = "ActiveTime" Then
            Kullanici_Sutunu = 1
            Zaman_Sutunu = 2
            Kayit_Sutunu = 6
        Else
            GoTo 10
        End If
            
        Son = Sh.Cells(Sh.Rows.Count, Kullanici_Sutunu).End(3).Row
    
        For X = 2 To Son
            If Sh.Cells(X, Kullanici_Sutunu) <> "" Then
                If InStr(1, Sh.Cells(X, Kullanici_Sutunu), "\") > 0 Then
                    Kullanici = Split(Sh.Cells(X, Kullanici_Sutunu), "\")(1)
                End If
                
                Zaman = Split(Sh.Cells(X, Zaman_Sutunu), " ")
                
                For Y = 0 To UBound(Zaman)
                    If InStr(1, Zaman(Y), "h") > 0 Then
                        Saat = Replace(Zaman(Y), "h", "")
                    ElseIf InStr(1, Zaman(Y), "m") > 0 Then
                        Dakika = Replace(Zaman(Y), "m", "")
                    ElseIf InStr(1, Zaman(Y), "s") > 0 Then
                        Saniye = Replace(Zaman(Y), "s", "")
                    End If
                Next
                
                Set Bul = S1.Range("D:D").Find(Kullanici, , , xlWhole)
                If Not Bul Is Nothing Then
                    S1.Cells(Bul.Row, Kayit_Sutunu) = S1.Cells(Bul.Row, Kayit_Sutunu) + TimeValue(Saat & ":" & Dakika & ":" & Saniye)
                    Saat = 0
                    Dakika = 0
                    Saniye = 0
                End If
            End If
        Next
10
    Next

    Set Bul = Nothing
    Set S1 = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[noartist]

Deneyiniz.

Option Explicit

Sub Pivot_Table()
    Dim S1 As Worksheet, Sh As Worksheet, Kullanici As String
    Dim Son As Long, X As Long, Saat As Byte, Dakika As Byte, Saniye As Byte
    Dim Zaman As Variant, Y As Byte, Bul As Range
    Dim Kullanici_Sutunu As Byte, Zaman_Sutunu As Byte, Kayit_Sutunu As Byte
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set S1 = Sheets("Rapor")

    S1.Range("E2:F" & S1.Rows.Count).ClearContents
    S1.Range("E2:F" & S1.Rows.Count).NumberFormat = "[hh]:mm:ss"
   
    For Each Sh In ThisWorkbook.Worksheets
               
        If Sh.Name = "TotalTime" Then
            Kullanici_Sutunu = 2
            Zaman_Sutunu = 3
            Kayit_Sutunu = 5
        ElseIf Sh.Name = "ActiveTime" Then
            Kullanici_Sutunu = 1
            Zaman_Sutunu = 2
            Kayit_Sutunu = 6
        Else
            GoTo 10
        End If
           
        Son = Sh.Cells(Sh.Rows.Count, Kullanici_Sutunu).End(3).Row
   
        For X = 2 To Son
            If Sh.Cells(X, Kullanici_Sutunu) <> "" Then
                If InStr(1, Sh.Cells(X, Kullanici_Sutunu), "\") > 0 Then
                    Kullanici = Split(Sh.Cells(X, Kullanici_Sutunu), "\")(1)
                End If
               
                Zaman = Split(Sh.Cells(X, Zaman_Sutunu), " ")
               
                For Y = 0 To UBound(Zaman)
                    If InStr(1, Zaman(Y), "h") > 0 Then
                        Saat = Replace(Zaman(Y), "h", "")
                    ElseIf InStr(1, Zaman(Y), "m") > 0 Then
                        Dakika = Replace(Zaman(Y), "m", "")
                    ElseIf InStr(1, Zaman(Y), "s") > 0 Then
                        Saniye = Replace(Zaman(Y), "s", "")
                    End If
                Next
               
                Set Bul = S1.Range("D:D").Find(Kullanici, , , xlWhole)
                If Not Bul Is Nothing Then
                    S1.Cells(Bul.Row, Kayit_Sutunu) = S1.Cells(Bul.Row, Kayit_Sutunu) + TimeValue(Saat & ":" & Dakika & ":" & Saniye)
                    Saat = 0
                    Dakika = 0
                    Saniye = 0
                End If
            End If
        Next
10
    Next

    Set Bul = Nothing
    Set S1 = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Teşekkür ederim, ellerinize sağlık.