shibashish mohanty Ответов: 2

Макрос листа Excel код VBA для среднего времени входа и выхода


Привет, мой лист Excel выглядит примерно так(он имеет три столбца: "дата и время", "описание события" и " имя")

Нужно рассчитать среднее время, которое сотрудник провел в этой комнате, с помощью макросов excel VBA-кода.


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



Пожалуйста, помогите мне. Заранее спасибо.

Что я уже пробовал:

На самом деле я хочу показать среднее время пребывания сотрудника в комнате, проверяя время входа и выхода.

2 Ответов

Рейтинг:
9

Maciej Los

[РЕДАКТИРОВАТЬ]
Чтобы рассчитать среднее время, вам нужно отсортировать данные по дате и пользователю, а затем "объединить" их. Что я имею в виду? Вы должны создать еще один набор данных, в котором время входа и время выхода будут близки друг к другу (в одной строке). Лист назначения должен выглядеть следующим образом:

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


Согласно приведенным ниже данным:
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


Макрос должен выглядеть так:
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


Результаты:
Лист2 (данные, которые будут использоваться сводной таблицей)
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

Лист3
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


Последнее замечание: это бонус для вас. В следующий раз-не ждите, что кто-то сделает эту работу за вас.


[no name]

Спасибо Мацей Лос.
Этот код не будет работать для приведенного ниже сценария.

Предположим, что два человека вошли в эту комнату в разное время.

Результат должен быть таким же,как среднее время первого человека на первом свидании, такое же среднее время первого человека на другом дне. то же самое будет применяться и к другим лицам.
Примерные данные будут выглядеть следующим образом
EventNo dtm Name Status
1 8/11/2017 10:46 запись шибашиша
2 8/11/2017 17:50 выход шибашиша
3 8/12/2017 17:51 запись шибашиша
4 8/12/2017 18:11 выход шибашиша
5 12/1/2017 19:00 вход в Ранджан
6 12/1/2017 19:21 выход Ранджана
7 8/11/2017 20:05 запись Ранджана
8 8/11/2017 21:55 выход Ранджана

И ожидаемый результат должен быть таким, как показано ниже
Имя Дата Среднее Время
шибашиш 8/11/2017 7: 04
шибашиш 8/12/2017 0:20
Раньян 12/1/2017 0:21
Раньян 8/11/2017 1:50


Пожалуйста, помогите мне в этом сценарии.
Заранее спасибо.

Maciej Los

Ну, первоначальный вопрос не содержал таких требований. Тем не менее...
У вас есть 2 варианта:
1) улучшите мой код, добавив 2 условия для проверки, если:
- дата меняется,
- имя пользователя меняется
В обоих случаях вам нужно добавить одну строку, чтобы добавить среднее время для каждой даты и пользователя

2) Создайте сводную таблицу, которая уже может группировать данные по дате и пользователю.

Примечание: Вы должны принимать все решения, применять (использовать зеленую кнопку).

Овации,
Мацей

[no name]

Большое спасибо за Ваш быстрый ответ.
Не могли бы вы пожалуйста добавить туда условие. я пытаюсь сделать то же самое, но получаю много проблем, чтобы получить результат.

С уважением
Shibashish

[no name]

Если в листе excel мои данные находятся в случайном порядке, как показано ниже. Вышеприведенное решение дает мне неправильный вывод.

EventNo dtm Name Status
1 8/11/2017 10:46 запись шибашиша
5 12/1/2017 19:00 вход в Ранджан
2 8/11/2017 17:50 выход шибашиша
6 12/1/2017 19:21 выход Ранджана
7 8/11/2017 20:05 запись Ранджана
2 8/11/2017 18:50 запись шибашиша
7 8/11/2017 20:05 выход шибашиша
8 8/11/2017 21:55 выход Ранджана

Maciej Los

Проверьте обновленный ответ.

[no name]

Он отлично работает. Большое спасибо..

Maciej Los

Всегда пожалуйста.

[no name]

Не могли бы вы помочь мне в этом посте
https://www.codeproject.com/Questions/1232181/How-to-write-macro-VBA-code-for-excel-sheet

Я знаю, что ты можешь это сделать. Пожалуйста, помогите мне. Спасибо

Рейтинг:
0

Richard MacCutchan

Видеть Функция поиска-офисная поддержка[^]. Вы можете запускать команды в Excel во время записи макроса, поэтому большая часть работы выполняется за вас.


[no name]

Привет, Ричард, Спасибо за ответ. Но для моего проекта мне нужно среднее время, где " имя " = "некоторое значение". Поэтому мне это нужно в Макрокоде.

Пожалуйста, помогите мне, если это возможно.

Richard MacCutchan

Извините, у меня нет времени писать ваш код.

Maciej Los

Ричард, функция поиска используется для поиска одного значения из указанного диапазона. ОП нужно посчитать время, проведенное в комнате,а затем рассчитать среднее.

Richard MacCutchan

Да. Я это понимаю. Я просто предложил отправную точку для поиска некоторых подходящих функций.