Excel工作表宏VBA代码，用于平均进出时间 [英] Excel sheet macro VBA code for average in and out time

问题描述

嗨我的Excel工作表看起来像这样（它有三列日期和时间，事件描述和名称）



需要通过excel宏vba代码计算员工在该房间内度过的平均时间。

Hi My Excel sheet looks something like this(It has three column as "Date and Time", "event Description" and "Name")

Need to calculate the average time an employee has spent inside that room by excel macros vba code.

Date and Time	 Event Description	Name
8/1/2017 11:43:02	Entry granted	shibashish
8/1/2017 11:58:48	Exit granted	shibashish
8/1/2017 12:04:28	Entry granted	shibashish
8/1/2017 12:57:20	Exit granted	shibashish
8/1/2017 13:54:49	Entry granted	shibashish
8/1/2017 14:09:06	Exit granted	shibashish
8/1/2017 14:19:26	Entry granted	shibashish
8/1/2017 15:34:24	Exit granted	shibashish
8/1/2017 16:20:11	Entry granted	shibashish
8/1/2017 17:25:23	Exit granted	shibashish
8/1/2017 18:36:16	Entry granted	shibashish
8/1/2017 19:21:22	Exit granted	shibashish

请帮助我。在此先感谢。



我尝试过的事情：



其实我是想通过检查进出时间来显示员工在房间内的平均时间。

Please help me. Thanks in advance.

What I have tried:

Actually i want to show the average time of an employee inside the room by checking the in and out time.

推荐答案

参见 LOOKUP功能 - Office支持 [ ^ ]。您可以在录制宏的同时在Excel中运行命令，因此大部分工作都是为您完成的。

See LOOKUP function - Office Support[^]. You can run commands in Excel while recording a macro so most of the work is done for you.

为了能够计算平均时间，您必须按日期和用户对数据进行排序，然后合并它们。我的意思是说？您必须创建另一组数据，其中输入时间和退出时间将彼此接近（在一行中）。目标表应如下所示：

To be able to calculate average time, you have to sort data by the date and user and then to "merge" them. What i mean? You have to create another set of data, in which entry time and exit time will be close each other (in one row). A destination sheet should looks like:

A - Name
B - Date
C - Entry time
D - Exit time
E - Time (minutes)

根据以下数据：

According to below data:

EventNo	dtm	Name	Status
1	2017-08-11 10:46	shibashish	Entry
2	2017-08-11 17:50	shibashish	Exit
2	2017-08-11 18:50	shibashish	Entry
5	2017-01-12 19:00	ranjan	Entry
6	2017-01-12 19:21	ranjan	Exit
7	2017-08-11 20:05	ranjan	Entry
7	2017-08-11 20:05	shibashish	Exit
8	2017-08-11 21:55	ranjan	Exit
9	2017-08-12 12:46	shibashish	Entry
10	2017-08-12 14:35	shibashish	Exit
11	2017-08-12 16:20	shibashish	Entry
12	2017-08-12 18:07	shibashish	Exit

宏应如下所示：

A macro should looks like:

Option Explicit

Sub MergeEvents()
    Dim srcWsh As Worksheet, dstWsh As Worksheet, pvtWsh As Worksheet
    Dim i As Long, j As Long
    
    On Error GoTo Err_MergeEvents
    
    'define "source" sheet
    Set srcWsh = ThisWorkbook.Worksheets(1)
    'sort data by user name (col. C) and date (col. B)
    'get last row
    i = srcWsh.Range("D" & srcWsh.Rows.Count).End(xlUp).Row
    srcWsh.Sort.SortFields.Clear
    srcWsh.Range("A1:D" & i).Sort Key1:=srcWsh.Range("C1"), Order1:=xlAscending, _
            Key2:=srcWsh.Range("B1"), Order2:=xlAscending, Header:=xlYes
    
    'define "destination" sheet
    Set dstWsh = ThisWorkbook.Worksheets(2)
    With dstWsh
        .UsedRange.Clear
        .Range("A1") = "Name"
        .Range("B1") = "Date"
        .Range("C1") = "Entry time"
        .Range("D1") = "Exit time"
        .Range("E1") = "Time (minutes)"
        .Range("A1:E1").Font.Bold = True
    End With
    
    'first row is a header, so start from row no. 2
    i = 2
    j = 2
    Do While srcWsh.Range("A" & i) <> ""
        If srcWsh.Range("D" & i) Like "Exit*" Then GoTo SkipNext
        'copy name
        dstWsh.Range("A" & j) = srcWsh.Range("C" & i)
        'date
        dstWsh.Range("B" & j) = CDate(Format(srcWsh.Range("B" & i), "yyyy-MM-dd"))
        'entry time
        dstWsh.Range("C" & j) = Format(srcWsh.Range("B" & i), "HH:nn")
        'exit time
        dstWsh.Range("D" & j) = Format(srcWsh.Range("B" & i + 1), "HH:nn")
        'get time difference in minutes
        dstWsh.Range("E" & j) = DateDiff("n", CDate(srcWsh.Range("B" & i)), CDate(srcWsh.Range("B" & i + 1)))
        j = j + 1
SkipNext:
        i = i + 1
    Loop
   
    srcWsh.UsedRange.Columns.AutoFit

    'define location for pivot table
    Set pvtWsh = ThisWorkbook.Worksheets(3)
    pvtWsh.Cells.Clear
    AddMyPivot dstWsh, dstWsh.Name & "!" & dstWsh.Range("A1:E" & j - 1).Address, pvtWsh.Range("A3")
    pvtWsh.Activate

Exit_MergeEvents:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Set pvtWsh = Nothing
    Exit Sub
    
Err_MergeEvents:
    MsgBox Err.Description, vbExclamation, "Error no. " & Err.Number
    Resume Exit_MergeEvents

End Sub

Sub AddMyPivot(ByRef dstWsh As Worksheet, ByVal src As String, ByVal dstLocation As Range)
    Dim i As Integer, pc As PivotCache, pt As PivotTable
        
    Set pc = dstWsh.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=src, Version:=xlPivotTableVersion14)
    Set pt = pc.CreatePivotTable(TableDestination:=dstLocation, TableName:="mypt1")
    
    With pt.PivotFields("Name")
        .Orientation = xlRowField
        .Position = 1
    End With
    With pt.PivotFields("Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    pt.AddDataField pt.PivotFields("Time (minutes)"), "Average time (minutes)", xlAverage
    dstWsh.Parent.ShowPivotTableFieldList = False
End Sub

结果：

Sheet2 （数据透视表将使用的数据）

Results:
Sheet2 (data which will be used by pivot table)

Name	Date	Entry time	Exit time	Time (minutes)
ranjan	2017-01-12	19:00	19:21	21
ranjan	2017-08-11	20:05	21:55	110
shibashish	2017-08-11	10:46	17:50	424
shibashish	2017-08-11	18:50	20:05	75
shibashish	2017-08-12	12:46	14:35	109
shibashish	2017-08-12	16:20	18:07	107

Sheet3

Sheet3

Average time (minutes)				
			2017-01-12	2017-08-11	2017-08-12	Total
ranjan		21			110					65,5
shibashish				249,5			108		178,75
Total		21			203			108		141

最后说明：这是给你的奖金。下次 - 不要指望有人会为你做这个工作。

Final note: This is a bonus for you. Next time - do not expect that some one will do the job for you.

这篇关于Excel工作表宏VBA代码，用于平均进出时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！