Макрос суммы времени - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

- - Макрос суммы времени (http://forum.oszone.net/showthread.php?t=326041)

Макрос суммы времени

Имею отчет в формате xls в котором эфирная справка где указано сколько времени был проигран тот или иной видео файл за сутки. Мне нужно посчитать суммарный хронометраж всех проигранных файлов, а их много за сутки проигрывается. Пример отчета прилагаю. Нужно суммировать колонку под названием "Длительность". Результат нужно напечатать после последней заполненной ячейки столбца "Длительность". Время в этой ячейке указано в формате ЧЧ:ММ:СС:КК (часы: минуты:секундны:кадры). Буду признателен в помощи!

Макрос — вот:

Скрытый текст

Код:

Option Explicit



Sub Sample()

    Dim objFoundRange As Range

    Dim objCalcRange As Range

    Dim objRange As Range

    

    Dim objRegExp As New VBScript_RegExp_55.RegExp

    

    Dim dtTotalTime As Date

    Dim intTimeValue As Integer

    

    

    With ActiveWorkbook.ActiveSheet

        Set objFoundRange = .UsedRange.Find("Длительность")

        

        If Not objFoundRange Is Nothing Then

            objRegExp.Pattern = "^(\d{2}):(\d{2}):(\d{2}):\d{2}$"

            

            dtTotalTime = TimeSerial(0, 0, 0)

            

            With Intersect(.UsedRange, objFoundRange.EntireColumn)

                Set objCalcRange = .Offset(1, 0).Resize(.Rows.Count - 1, 1)

            End With

            

            For Each objRange In objCalcRange

                If objRegExp.Test(objRange.Value) Then

                    With objRegExp.Execute(objRange.Value).Item(0).SubMatches

                        intTimeValue = CInt(.Item(0)) * 60 * 60 + CInt(.Item(1)) * 60 + CInt(.Item(2))

                    End With

                    

                    dtTotalTime = DateAdd("s", intTimeValue, dtTotalTime)

                End If

            Next

            

            With objCalcRange

                With .Offset(.Rows.Count, 0).Resize(1, 1)

                    .Value = dtTotalTime

                    .NumberFormat = "hh:mm:ss;@"

                End With

            End With

        Else

            MsgBox "Can't find word [Длительность] in active worksheet", vbOKOnly + vbExclamation, "Not found"

        End If

    End With

End Sub

Не забудьте установить для проекта ссылку на библиотеку:

Скрытый текст

Iska,

ИМХО фэншуйнее написать функцию, а не рутину

Код:

Function SumTimeK(Atime As Range) As String

    Dim DSumTime As Long, DSumK As Long

    Dim hh As Long, mm As Integer, ss As Integer

    Dim UmAtime As Integer

    

    DSumTime = 0

    DSumK = 0

    

    For Each iAtime In Atime

        mAtime = Split(iAtime, ":")

        UmAtime = UBound(mAtime)

        If UmAtime >= 0 Then

            DSumTime = DSumTime + CLng(mAtime(0)) * 3600

            If UmAtime >= 1 Then DSumTime = DSumTime + CLng(mAtime(1)) * 60

            If UmAtime >= 2 Then DSumTime = DSumTime + CLng(mAtime(2))

            If UmAtime >= 3 Then DSumK = DSumK + CLng(mAtime(3))

        End If

    Next

    

    hh = Int(DSumTime / 3600)

    mm = Int((DSumTime - hh * 3600) / 60)

    ss = DSumTime - hh * 3600 - mm * 60

    

    SumTimeK = IIf(hh < 10, "0" + CStr(hh), CStr(hh)) + ":" + Mid(CStr((100 + mm)), 2, 2) + ":" + Mid(CStr((100 + ss)), 2, 2) + ":" + CStr(DSumK)

End Function

Какая в этом радость: её можно использовать как стандартную функцию Excel, наманер, например, =СУММА(.....). Не помню уже как, её можно сделать доступной для всех таблиц на компьютере.
d22cva, отдаю Вам Ваш файл с функцией. Что такое кадры, я не знаю, подозреваю, что они считаются неправильно. Уточняйте задачу, исправлю

megaloman, насколько я помню — вообще-то в таком виде нельзя. Точнее — «…можно, но только один раз»™ ;).

Excel Recalculation: Volatile and Non-Volatile Functions

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

Вот погуглил, нашёл.

Цитата:

Цитата http://www.script-omen.com/2014/03/excel-udf.html Создание пользовательских функций (формул) в Excel (UDF)

...будьте внимательны при использовании нескольких книг Excel одновременно. Бывали случаи, когда программный модуль начинал работать некорректно даже в файле, к которому он был привязан, после открытия файла с альтернативным пользовательским программным модулем. Некорректность работы заключается в том, что даже при наличии требуемого программного модуля, все пользовательские формулы в документе перестают работать. Подобная проблема решается созданием нового документа Excel с новым модулем – в который необходимо скопировать текст вашей функции (ВАЖНО!: копируется только текст, экспортирование программного модуля в новый документ не помогает). Такая проблема вызывает определенные неудобства и встречается не у всех, но все же, чтобы предотвратить появление подобных проблем и путаницы между пользовательскими модулями – настоятельно рекомендуется открывать одновременно только ОДИН файл с пользовательскими функциями. Повторюсь, что у большинства пользователей эта проблема не возникает и причины ее возникновения зависят от уровня безопасности и уровня доступа пользователя в системе.

megaloman, не в том дело. Пересчёт не будет работать. То есть, проще говоря, без .Volatile функция не будет являться функцией Рабочего листа.

Iska, В той таблице, что я представил, у меня пересчёт работает.

megaloman, подтверждаю. ~~Стало быть, я наглым образом путаю тут с прежними версиями.~~ Во всяком случае, для 2003 сказано иное, нежели мне представлялось по старой памяти:

Цитата:

Marks a user-defined function as volatile. A volatile function must be recalculated whenever calculation occurs in any cells on the worksheet. A nonvolatile function is recalculated only when the input variables change. This method has no effect if it's not inside a user-defined function used to calculate a worksheet cell.

То бишь, в данном случае, действительно, не требуется. Поправил свои сообщения выше.

megaloman, исправляюсь: на самом деле™ указанное поведение присутствовало с самой первой версии VB (в Microsoft Excel 5.0, когда он ещё даже не получил ~~приставку~~ суффикс for Application). Основная разница тут в чём: volatile-функции вызываются на каждый ~~чих~~ пересчёт листа, независимо от того, какие ячейки пересчитываются. Критичным сие может быть в том случае, если мы используем в функции какие-либо внешние независимые факторы, скажем — функция у нас возвращает случайное число, текущее время, да число файлов в каталоге, наконец. Либо же мы не передаём все влияющие ячейки в функцию, а частично или полностью извлекаем их значения непосредственно в коде.

Поправил своё предыдущее сообщение.

Цитата:

Цитата Iska

Критичным сие может быть в том случае, если мы используем в функции какие-либо внешние независимые факторы, скажем — функция у нас возвращает случайное число, текущее время, да число файлов в каталоге, наконец. »

Можно конфузию обратить и в викторию, например, использование функции на листе

Код:

Function Kuku(InR As Range) As String

    Kuku = CStr(InR) + "  " + CStr(Now())

End Function

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

Вот, кстати, да. Но я бы предпочёл фиксировать время рядом, скажем, в соседней ячейке.

Iska, Функция

Код:

Function Kuku000(InR As Range) As String

    Kuku000 = CStr(Now())

End Function

работает при изменении ячейки, на которую ссылается, главное, похоже, чтобы ячейка фигурировала в аргументе