Учет рабочего времени

@MexaT · Регистрация: 10.11.2016

Author24 — интернет-сервис помощи студентам

Добрый день

Есть Sheets "Data" в которой ведется учет ухода/прихода сотрудника в течении дня.
В Sheets "result" должна появится таблица с ФИО сотрудника и количеством часов нахождения в офисе за определенный день

Понимаю что должны быть циклы, которые считывают фамилию, суммируют всё время нахождение в офисе и помещает эти данные в Sheets "result". Но в VBA не силен и все примеры на сайте мне не подходят.
Пустые поля под фамилией это тот же сотрудник.Время выводится с номером турникета.

Спасибо.

@korvindeson · 11.11.2016, 03:05

Пойдёт? На второй вкладке можно добавлять имён скок хотите вниз и дат скок хотите вправо. Только фразу "Сумма за неделю" не забудьте оставить.

Visual Basic

Sub test()
 
Set spis = ThisWorkbook.Worksheets(1)
Set otch = ThisWorkbook.Worksheets(2)
 
 
spis.Cells.Replace " (*)", ""
i = 4
 
On Error Resume Next
 
Do While otch.Cells(i, 2) <> ""
    j = 3
    Do While otch.Cells(3, j) <> "Ñóììà çà íåäåëþ"
        r = ""
        
        r = spis.Range(spis.Cells(8, 1), spis.Cells(65536, 1)).Find(otch.Cells(3, j)).Row
        If r <> "" Then
            r2 = r
            If spis.Cells(r2 + 1, 1) Like "" And spis.Cells(r2 + 1, 4) <> "" Then spis.Cells(r2 + 1, 1) = spis.Cells(r2, 1)
            
            spis.Range("F" & r2).FormulaR1C1 = "=RC[-1]-RC[-2]"
            
            Do While spis.Cells(r2 + 1, 1) Like otch.Cells(3, j)
                r2 = r2 + 1
                If spis.Cells(r2 + 1, 1) Like "" And spis.Cells(r2 + 1, 4) <> "" Then spis.Cells(r2 + 1, 1) = spis.Cells(r2, 1)
                spis.Range("F" & r2).FormulaR1C1 = "=RC[-1]-RC[-2]"
            Loop
            sotr = ""
            sotr = spis.Range(spis.Cells(r - 1, 2), spis.Cells(r2, 2)).Find(what:=otch.Cells(i, 2)).Row
            Tot = sotr
            If sotr <> "" Then
                If spis.Cells(sotr + 1, 2) Like "" And spis.Cells(sotr + 1, 4) <> "" Then spis.Cells(sotr + 1, 2) = spis.Cells(sotr, 2)
                Do While spis.Cells(sotr + 1, 2) Like otch.Cells(i, 2)
                    sotr = sotr + 1
                    If spis.Cells(sotr + 1, 2) Like "" And spis.Cells(sotr + 1, 4) <> "" Then spis.Cells(sotr + 1, 2) = spis.Cells(sotr, 2)
                Loop
                spis.Range("G" & Tot).FormulaR1C1 = "=SUM(RC[-1]:R[" & sotr - Tot & "]C[-1])"
            End If
            otch.Cells(i, j) = spis.Cells(Tot, 7).Value
            otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "hh:mm"
            spis.Cells(Tot, 7) = ""
        End If
    j = j + 1
    Loop
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "d hh:mm"
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).FormulaR1C1 = "=SUM(RC[-1]:RC[-" & j - 3 & "])"
    
    s = Split(otch.Cells(i, j).Text, " ")
    s2 = Split(s(1), ":")
    
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "@"
    Tot = CStr(s(0) * 24 + s2(0)) & ":" & s2(1)
    otch.Range(otch.Cells(i, j), otch.Cells(i, j)).NumberFormat = "@"
    otch.Cells(i, j) = Tot
    
i = i + 1
Loop
 
spis.Columns(6).Delete
On Error GoTo 0
 
End Sub

@korvindeson · 11.11.2016, 03:10

Если кто-то будет работать больше 23 часов 59 минут, бага случится (=
И кракозябры в коде заменить бы на "Сумма за неделю"

@MexaT · 11.11.2016, 10:44 **[ТС]**

Спасибо, а как сделать чтобы имена(вниз) и даты(вправо) появлялись автоматически? Список будет из 250 сотрудников

@korvindeson · 11.11.2016, 20:20

Не беда, добавлю как время будет.

@korvindeson · 11.11.2016, 21:52

На здоровье

@korvindeson · 11.11.2016, 22:31

Не, в той баги. Почистил. Если будете какие-то даты руками вписывать, то сначала скопируйте уже существующую, потом правьте. Если просто текстом введёте скорее всего будет игнорироваться.

toiai · 12.11.2016, 00:33

Как вариант предложу вариант с формированием сводной таблицы к данным #1:

Visual Basic

Sub pr()
    Dim b(), pRSet As Object
    a = [a7].CurrentRegion.Value
    ReDim b(UBound(a) - 2, 2)
    b(0, 0) = "Дата": b(0, 1) = "ФИО": b(0, 2) = "Время"
    For i = 3 To UBound(a)
        dt = IIf(IsEmpty(a(i, 1)), dt, a(i, 1))
        b(i - 2, 0) = dt
        fio = IIf(IsEmpty(a(i, 2)), fio, a(i, 2))
        b(i - 2, 1) = fio
        b(i - 2, 2) = CDate(Format(CDate(Split(a(i, 5))(0)) - CDate(Split(a(i, 4))(0)), "hh:mm"))
    Next
    aType = Array("202 10", "202 30", "7")
    Set pRSet = CreateObject("ADODB.Recordset")
    For i = 0 To 2
        s = Split(aType(i))
        If UBound(s) > 0 Then
            pRSet.Fields.Append b(0, i), s(0), s(1)
        Else
            pRSet.Fields.Append b(0, i), s(0)
        End If
    Next
    pRSet.CursorLocation = 3
    pRSet.Open
    For i = 1 To UBound(b)
        pRSet.AddNew
        For k = 0 To 2
            pRSet(k).Value = b(i, k)
        Next k
    Next
    pRSet.MoveFirst
    Sheets.Add
    Set pCache = ThisWorkbook.PivotCaches.Create(xlExternal)
    Set pCache.Recordset = pRSet
    pName = "PT" & CLng(Timer)
    pCache.CreatePivotTable Range("A3"), pName, True
    pRSet.Close
    With ActiveSheet.PivotTables(pName)
        .PivotFields("ФИО").Orientation = xlRowField
        .PivotFields("Дата").Orientation = xlColumnField
        .AddDataField .PivotFields("Время"), "Отработано времени", xlSum
        .PivotFields("Отработано времени").NumberFormat = "[h]:mm:ss;@"
        .ColumnGrand = False
    End With
End Sub

@korvindeson · 12.11.2016, 05:12

toiai, хотел короче написать, не вышло (: Но так поинтереснее всё равно.

Visual Basic

Sub test()
 
Dim arr(10000, 2)
Set spis = ThisWorkbook.Worksheets(1)
Set otch = ThisWorkbook.Worksheets(2)
Set s = CreateObject("scripting.dictionary")
 
spis.Cells.Replace " (*)", ""
otch.Cells.Clear
lRow = spis.Cells(spis.Rows.Count, 4).End(xlUp).Row
i = 0
 
On Error Resume Next
    For j = 9 To lRow
        If spis.Cells(j, 2) <> "" Then
            If spis.Cells(j + 1, 2) Like "" And spis.Cells(j + 1, 4) <> "" Then
                jj = spis.Cells(j + 1, 2).End(xlDown).Row - 1
                spis.Range(spis.Cells(j, 6), spis.Cells(j, 6)).FormulaR1C1 = "=SUM(RC[-1]:R[" & jj - j & "]C[-1]) - SUM(RC[-2]:R[" & jj - j & "]C[-2])"
            Else
                spis.Range(spis.Cells(j, 6), spis.Cells(j, 6)).FormulaR1C1 = "=RC[-1]-RC[-2]"
            End If
            
            Err.Clear
            s.Add spis.Cells(j, 1).Text, ""
            If Err = 0 Then
                i = 0
                Erase arr
            End If
            arr(i, 0) = spis.Cells(j, 2).Text
            arr(i, 1) = spis.Cells(j, 6).Value
            i = i + 1
            s(spis.Cells(j, 1).Text) = arr
        End If
    Next
On Error GoTo 0
 
 
j = 3
i = 4
On Error Resume Next
    For Each k In s.Keys
        otch.Cells(3, j) = k
        sot = 0
        Do While s(k)(sot, 0) <> ""
            r = ""
            r = otch.Cells.Find(s(k)(sot, 0)).Row
            If r <> "" Then
                otch.Cells(r, j) = s(k)(sot, 1)
            Else
                otch.Cells(i, 2) = s(k)(sot, 0)
                otch.Cells(i, j) = s(k)(sot, 1)
                i = i + 1
            End If
        sot = sot + 1
        Loop
        j = j + 1
    Next
On Error GoTo 0
 
otch.Range(otch.Cells(4, 3), otch.Cells(i, j - 1)).NumberFormat = "hh:mm"
otch.Cells(3, j) = "Сумма за неделю"
otch.Range(otch.Cells(4, j), otch.Cells(i - 1, j)).FormulaR1C1 = "=SUM(RC[-" & j - 3 & "]:RC[-1])"
spis.Columns(6).Delete
 
End Sub

Добавлено через 13 минут
Не, вру опять всего не правильно считаю. Не получается сократиться. Концовка

Visual Basic

otch.Range(otch.Cells(4, j), otch.Cells(i - 1, j)).FormulaR1C1 = "=SUM(RC[-" & j - 3 & "]:RC[-1])"
otch.Range(otch.Cells(4, j), otch.Cells(i - 1, j)).NumberFormat = "d hh:mm"
For ii = 4 To i - 1
    s1 = Split(otch.Cells(ii, j).Text, " ")
    s2 = Split(s1(1), ":")
    
    Tot = CStr(s1(0) * 24 + s2(0)) & ":" & s2(1)
    otch.Range(otch.Cells(ii, j), otch.Cells(ii, j)).NumberFormat = "@"
    otch.Cells(ii, j) = Tot
Next

@MexaT · 14.11.2016, 15:13 **[ТС]**

korvindeson, Спасибо, мне нужно пустые поля заполнять макросом?

@korvindeson · 14.11.2016, 22:57

MexaT, вопрос не понял.

@MexaT · 15.11.2016, 15:00 **[ТС]**

korvindeson, Уже разобрался не тот пример скачал

@korvindeson 1261 / 147 / 32 Регистрация: 11.02.2011 Сообщений: 418
	11.11.2016, 03:10	3
	Если кто-то будет работать больше 23 часов 59 минут, бага случится (= И кракозябры в коде заменить бы на "Сумма за неделю" 1

@MexaT 0 / 0 / 0 Регистрация: 10.11.2016 Сообщений: 4
	11.11.2016, 10:44 [ТС]	4
	Спасибо, а как сделать чтобы имена(вниз) и даты(вправо) появлялись автоматически? Список будет из 250 сотрудников 0

@korvindeson 1261 / 147 / 32 Регистрация: 11.02.2011 Сообщений: 418
	11.11.2016, 20:20	5
	Не беда, добавлю как время будет. 0

@MexaT 0 / 0 / 0 Регистрация: 10.11.2016 Сообщений: 4
	14.11.2016, 15:13 [ТС]	10
	korvindeson, Спасибо, мне нужно пустые поля заполнять макросом? 0

@korvindeson 1261 / 147 / 32 Регистрация: 11.02.2011 Сообщений: 418
	14.11.2016, 22:57	11
	MexaT, вопрос не понял. 0

@MexaT 0 / 0 / 0 Регистрация: 10.11.2016 Сообщений: 4
	15.11.2016, 15:00 [ТС]	12
	korvindeson, Уже разобрался не тот пример скачал 0