vba - 如何将 SRT 文件制作成数据集？

Question

是否可以将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

Answer 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

---

从网站 URL 导入 SRT 字幕：

或者，您可以使用以下命令从网站URL（例如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'd 文件。

---

更多信息：

• 维基百科：SubRip & SRT

• MSDN：拆分函数（VBA）

• 维基百科：换行符

• MSDN : UBound 函数

• MSDN：Range.TextToColumns 方法 (Excel)

• SubRip 官方网站

Answer 2

在上面的代码中：

'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 行开始