如何将SRT文件转换为数据集?

时间:2018-02-28 21:12:52

标签: excel vba excel-vba srt

是否可以将用于视频中字幕的SRT文件转换为数据集

导入Excel时,SRT文件格式如下所示:

1
00:00:03,000 --> 00:00:04,000
OVERLAPS PURE COINCIDENCE THAT

...

随着“视频”/成绩单中的时间继续,此模式将继续。我想以这种方式格式化SRT文件:

number ; start ; end ; text

1 ; 00:00:03,000 ; 00:00:04,000 ; OVERLAPS PURE COINCIDENCE THAT

2 个答案:

答案 0 :(得分:1)

下面的VBA过程从本地文件加载标准.srt(SubRip电影字幕文件),并将其拆分为活动Excel工作表上的行/列。

从本地文件导入SRT字幕:

Sub importSRTfromFile(fName As String)
'Loads SRT from local file and converts to columns in Active Worksheet

    Dim sIn As String, sOut As String, sArr() As String, x As Long

    'load file
    Open fName For Input As #1
        While Not EOF(1)
            Line Input #1, sIn
            sOut = sOut & sIn & vbLf
        Wend
    Close #1

    'convert LFs to delimiters & split into array
    sOut = Replace(sOut, vbLf & vbLf, vbCr)
    sOut = Replace(Replace(sOut, vbLf, "|"), " --> ", "|")
    sArr = Split(sOut, vbCr)

    'check if activesheet is blank
    If ActiveSheet.UsedRange.Cells.Count > 1 Then
        If MsgBox(UBound(sArr) & " rows found." & vbLf & vbLf & _
            "Okay to clear worksheet '" & ActiveSheet.Name & "'?", _
            vbOKCancel, "Delete Existing Data?") <> vbOK Then Exit Sub
        ActiveSheet.Cells.ClearContents
    End If

    'breakout into rows
    For x = 1 To UBound(sArr)
        Range("A" & x) = sArr(x)
    Next x

    'split into columns
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
        DataType:=xlDelimited, Other:=True, OtherChar:="|"

    MsgBox "Imported " & UBound(sArr) & " rows from:" & vbLf & fName

End Sub

使用示例:

Sub test_FileImport()
    importSRTfromFile "c:\yourPath\yourFilename.srt"
End Sub

从网站网址导入SRT字幕:

或者,您可以使用以下内容从网站网址(例如https://subtitle-index.org/)导入.srt(或其他类似文本文件):

Sub importSRTfromWeb(url As String)
'Loads SRT from URL and converts to columns in Active Worksheet

    Dim sIn As String, sOut As String, sArr() As String, rw As Long
    Dim httpData() As Byte, XMLHTTP As Object

    'load file from URL
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.send
    httpData = XMLHTTP.responseBody
    Set XMLHTTP = Nothing
    sOut = StrConv(httpData, vbUnicode)

    'convert LFs to delimiters & split into array
    sOut = Replace(sOut, vbLf & vbLf, vbCr)
    sOut = Replace(Replace(sOut, vbLf, "|"), " --> ", "|")
    sArr = Split(sOut, vbCr)

    'check if activesheet is blank
    If ActiveSheet.UsedRange.Cells.Count > 1 Then
        If MsgBox(UBound(sArr) & " rows found." & vbLf & vbLf & _
            "Okay to clear worksheet '" & ActiveSheet.Name & "'?", _
            vbOKCancel, "Delete Existing Data?") <> vbOK Then Exit Sub
        ActiveSheet.Cells.ClearContents
    End If

    'breakout into rows
    For rw = 1 To UBound(sArr)
        Range("A" & rw) = sArr(rw)
    Next rw

    'split into columns
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
        DataType:=xlDelimited, Other:=True, OtherChar:="|"
    MsgBox "Imported " & UBound(sArr) & " rows from:" & vbLf & url

End Sub

示例用法:

Sub testImport()
    importSRTfromWeb _
        "https://subtitle-index.org/download/4670541854528212663953859964/SRT/Pulp+Fiction"
End Sub

许多网站免费提供.srt个;您可能必须右键单击下载按钮才能复制链接(可能具有.srt扩展名,或者可能是指针,如上例所示)。该程序无法处理.zip个文件。

更多信息:

答案 1 :(得分:0)

在上面的代码中:

'breakout into rows For rw = 1 To UBound(sArr) Range("A" & rw) = sArr(rw) Next rw

应替换为:

'breakout into rows For rw = 0 To UBound(sArr) Range("A" & rw+1) = sArr(rw) Next rw

否则输出将从第2行开始