Function Perec$(s$, шт$)
'на листе =Perec(C3;"шт")

    Dim d As Object, arr, arr2, i&, k

    s = Replace(s, ",", "")
    s = Replace(s, шт, "")

    If Len(s) > 2 Then

        Set d = CreateObject("Scripting.Dictionary")
        d.comparemode = 1

        arr = Split(s)
        For i = 0 To UBound(arr)
            arr2 = Split(arr(i), "-")
            d.Item(arr2(0)) = d.Item(arr2(0)) + --arr2(1)
        Next

        s = ""
        For Each k In d.keys
            s = s & ", " & k & "-" & d.Item(k) & шт
        Next
        Perec = Mid(s, 3)

    End If
End Function

Function КАТПЛАТЕЛЬЩИК$(txt$)
    Static d As Object
    Dim a, i&, t$, qWords

    txt = Trim(txt)

    If d Is Nothing Then

        Set d = CreateObject("Scripting.Dictionary")
        d.CompareMode = 1

        'a = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").Range("A1").CurrentRegion.Value 'не работает в UDF!
        a = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").UsedRange.Value
        For i = 1 To UBound(a)
            t = Trim(a(i, 1))
            d.Item(t) = a(i, 2)
        Next
        a = Empty

    End If

    If d.exists(txt) Then КАТПЛАТЕЛЬЩИК = d.Item(txt): Exit Function

    КАТПЛАТЕЛЬЩИК = "Уточнить"

    '----------посчитаем кол-во слов--------------------------------------------------
    qWords = UBound(Split(txt))
    '--------------------------------------------------------------------------------

    If qWords > 0 Then

        Select Case True
        Case txt Like "ООО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
        Case txt Like "* ООО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
        Case txt Like "АО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
        Case txt Like "* АО": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
        Case txt Like "ИП *": КАТПЛАТЕЛЬЩИК = "ИП"
        Case txt Like "* ИП": КАТПЛАТЕЛЬЩИК = "ИП"
        Case Else: КАТПЛАТЕЛЬЩИК = "Уточнить"
        End Select

    End If

End Function

Dim objExcel, tst, tm

tm = Timer

Set objFSO = CreateObject("Scripting.FileSystemObject")

arr = Split(""" date=""|"" time=""|"" duration=""|"" fadeIn=""|"" file=""|"" fadeOut=""|"" realDuration=""|"" error=""", "|")

For Each InputFile In WScript.Arguments

    pth = objFSO.GetFile(InputFile).Path
    Set ts = objFSO.OpenTextFile(InputFile, 1)

    s = ts.ReadAll
    ts.Close

    For Each el In arr
        s = Replace(s, el, "|||")
    Next

    arrstr = Split(s, vbCrLf)    'массив строк текста целиком

    ReDim out(UBound(arrstr), 3)

    ii = 0

    out(ii, 0) = "Имя файла"
    out(ii, 1) = "Время выхода"
    out(ii, 2) = "Продолжительность"
    out(ii, 3) = "Ошибка"

    For i = 0 To UBound(arrstr)
        If Left(arrstr(i), 17) = "<item type=""Movie" Then
            arrstrstr = Split(arrstr(i), "|||")
            ii = ii + 1
            a = Split(arrstrstr(5), "\")
            out(ii, 0) = Split(a(UBound(a)), ".")(0)
            out(ii, 1) = arrstrstr(2)
            out(ii, 2) = arrstrstr(3)
            If Left(arrstrstr(8), 1) = "1" Then out(ii, 3) = arrstrstr(7)
        End If
    Next


    ActivateExcel

    Set wb = objExcel.Workbooks.Add    '# открываем новую книгу Excel

    wb.Sheets(1).Cells(2, 2).Resize(ii, 3).NumberFormat = "h:mm:ss"

    With wb.Sheets(1).Cells(1, 1).Resize(ii + 1, 4)
        .Value = out
        .EntireColumn.AutoFit()
    End With

    wb.SaveAs Replace(pth, ".PlayReport", ".xlsx"), 51
    wb.Close 0

Next

'закрываем Excel-процесс
If tst Then objExcel.Quit

MsgBox "Выполнено за " & Timer - tm & " сек."

Private Function ActivateExcel()
    On Error Resume Next
    Set objExcel = GetObject(, "Excel.Application")
    If objExcel Is Nothing Then
        tst = True
        Set objExcel = CreateObject("Excel.Application")
        'objExcel.Visible = True
    End If
End Function

Dim objExcel

'Set objDialog = CreateObject("UserAccounts.CommonDialog")
'objDialog.Filter = "Input Files|*.PlayReport|All Files|*.*"
'objDialog.FilterIndex = 1
'objDialog.InitialDir = ""
'intResult = objDialog.ShowOpen

'    If intResult = 0 Then
'        WScript.Quit
'    Else
'        InputFile = objDialog.Filename
'    End If


arr = Split(""" date=""|"" time=""|"" duration=""|"" fadeIn=""|"" file=""|"" fadeOut=""|"" realDuration=""|"" error=""", "|")

For Each InputFile In WScript.Arguments
    MsgBox InputFile
    Set ts = CreateObject("Scripting.FileSystemObject").OpenTextFile(InputFile, 1)
    s = ts.ReadAll
    ts.Close

    For Each el In arr
        s = Replace(s, el, "|||")
    Next

    arrstr = Split(s, vbCrLf)    'массив строк текста целиком

    ReDim out(UBound(arrstr), 3)

    ii = 0

    out(ii, 0) = "Имя файла"
    out(ii, 1) = "Время выхода"
    out(ii, 2) = "Продолжительность"
    out(ii, 3) = "Ошибка"

    For i = 0 To UBound(arrstr)
        If Left(arrstr(i), 17) = "<item type=""Movie" Then
            arrstrstr = Split(arrstr(i), "|||")
            ii = ii + 1
            a = Split(arrstrstr(5), "\")
            out(ii, 0) = Split(a(UBound(a)), ".")(0)
            out(ii, 1) = arrstrstr(2)
            out(ii, 2) = arrstrstr(3)
            If Left(arrstrstr(8), 1) = "1" Then out(ii, 3) = arrstrstr(7)
        End If
    Next


    ActivateExcel

    objExcel.Workbooks.Add    '# открываем новую книгу Excel

    objExcel.Cells(2, 2).Resize(ii, 3).NumberFormat = "h:mm:ss"

    With objExcel.Cells(1, 1).Resize(ii + 1, 4)
        .Value = out
        .EntireColumn.AutoFit()
    End With

Next

Private Function ActivateExcel()
    On Error Resume Next
    Set objExcel = GetObject(, "Excel.Application")
    If objExcel Is Nothing Then
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = True
    End If
End Function