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

[d22cva]

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

[Iska]

Макрос — вот:
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

Не забудьте установить для проекта ссылку на библиотеку:
http://i.imgur.com/fl12Foi.png

[megaloman]

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, отдаю Вам Ваш файл с функцией. Что такое кадры, я не знаю, подозреваю, что они считаются неправильно. Уточняйте задачу, исправлю

[Iska]

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

Excel Recalculation: Volatile and Non-Volatile Functions (https://msdn.microsoft.com/en-us/library/office/bb687891.aspx#sectionSection2)

[megaloman]

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

[Iska]

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

[megaloman]

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

[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.
То бишь, в данном случае, действительно, не требуется. Поправил свои сообщения выше.

[Iska]

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

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

[megaloman]

Критичным сие может быть в том случае, если мы используем в функции какие-либо внешние независимые факторы, скажем — функция у нас возвращает случайное число, текущее время, да число файлов в каталоге, наконец. » Можно конфузию обратить и в викторию, например, использование функции на листе Function Kuku(InR As Range) As String
Kuku = CStr(InR) + " " + CStr(Now())
End Function позволяет зафиксировать время последнего изменения указанной клетки, что может оказаться полезным при сборе каких-либо сведений.

[Iska]

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

[megaloman]

Iska, Функция Function Kuku000(InR As Range) As String
Kuku000 = CStr(Now())
End Function работает при изменении ячейки, на которую ссылается, главное, похоже, чтобы ячейка фигурировала в аргументе