[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

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

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

[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

[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

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