Макрос суммы времени
Вложений: 1
Имею отчет в формате 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
Не забудьте установить для проекта ссылку на библиотеку:
|
Вложений: 1
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, Не буду врать, 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
работает при изменении ячейки, на которую ссылается, главное, похоже, чтобы ячейка фигурировала в аргументе
|
Время: 23:06.
© OSzone.net 2001-
