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

---

下面的VBA过程从本地文件加载标准的

.srt

（SubRip电影字幕文件），并将其拆分为活动Excel工作表上的行/列

从本地文件导入SRT字幕：

---

从网站URL导入SRT字幕： 或者，您可以从网站URL导入

.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

许多网站免费托管

.srt

；您可能需要右键单击下载按钮来复制链接（该链接可能具有

.srt

扩展名，或者可能是指针，如上面的示例所示）。此过程对

.zip

'd文件无效

---

更多信息：

• 维基百科：

• MSDN：

• 维基百科：

• MSDN：

• MSDN：

在上述代码中：

“拆分成行
对于rw=1至UBound（sArr）
范围（“A”和rw）=sArr（rw）
下一个rw

应替换为：

“拆分成行
对于rw=0至UBound（sArr）
范围（“A”和rw+1）=sArr（rw）
下一个rw

---

否则，输出将从第2行开始

，或者使用良好的文本编辑器在文件上运行正则表达式，将其转换为.csv或制表符分隔的文件，然后以Excel格式打开子RIPTEXT文件，看起来固定宽度应该可以工作。可以打开Excel，转到“数据”选项卡，选择“打开文本文件”，然后指定要打开的文件。导入向导将引导您完成，显示您所做选择的输出外观。您是否计划导入多个SRT？我问的原因是，它们可以有稍微不同的格式。事实上，如果你的样本是每行一条记录，那么它是非标准的。啊哈，我看到了问题。。。我修正了你的格式。我正好有一些东西可以帮你解决这个问题。我想对这个问题进行修正，因为将SRT数据输入电子表格是一个非常简单的要求。我希望在这里的评论中给出的答案是对这个问题的详细的实际答案。关于使用导入向导的那个似乎特别有希望。

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

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