excel - 将表格数据转换为字幕文本文件格式 (.srt) UTF-8

Question

我在 excel 中有股票市场数据，我希望将其转换为带有编码 UTF-8 和扩展名 .srt 的文本文件，这对我来说似乎是一项非常困难的任务。我知道如何将 excel 文件转换为文本文件，但在这种情况下，需要在转换之前完成处理，这似乎有点忙。我需要做的是考虑很少的规则，将表格数据放在一列（另一列下方）中。我不知道如何用文本解释我的查询，这就是为什么我要附上 excel 文件的屏幕截图。在随附的 excel 文件屏幕截图中，表格数据以绿色突出显示，转换后的数据看起来如何以黄色突出显示。需要如何处理数据的说明以蓝色文本书写。

这只是一个示例数据。原始数据的大小会更大。Equity 标题下的样本数据中有 6 家公司，Mutual Funds 下有 1 家公司，Foreign Exchange 下有 1 家，但在实际数据中，类别更多，每个类别中的数据更多（样本数据中只有 3类别）。有人可以告诉我如何在 Excel VBA 中实现这一点吗

我在excelforum上发布了这个，但没有收到任何回复。感谢一些帮助。 Excel论坛链接在这里

谢谢

谢谢。

标签： excelvba

Answer 1

尝试

Sub test()
    Dim vDB, vR()
    Dim s As String, s2 As String
    Dim sT As Integer, sE As Integer, co As Integer
    Dim str As String, strResult As String
    Dim i As Long, n As Long, c As Long, r As Long
    Dim num As Long
    Dim T1 As String, T2 As String
    Dim strFn As String

    s = vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
    s2 = "," & Format(0, "000")

    vDB = Range("a1").CurrentRegion
    n = UBound(vDB, 1)
    sT = 1
    For i = 1 To n
        If vDB(i, 2) = "" Then
            num = num + 1
            c = c + 5
            If num = 1 Then
                sE = sT + 4
            Else
                sT = sE + 1
                sE = sT + 9
            End If
            T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
            T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
            ReDim Preserve vR(1 To c)
            vR(c - 4) = num
            vR(c - 3) = T1 & s2 & "-->" & T2 & s2
            vR(c - 2) = s
            vR(c - 1) = vDB(i, 1)
            vR(c) = s
        Else
            r = r + 1
            If r = 1 Then
                num = num + 1
                c = c + 4
                sT = sE + 1
                sE = sT + 9
                T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
                T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
                ReDim Preserve vR(1 To c)
                vR(c - 3) = num
                vR(c - 2) = T1 & s2 & "-->" & T2 & s2
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf
            Else
                c = c + 2
                 ReDim Preserve vR(1 To c)
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf
                If r = 3 Then r = 0
            End If
        End If
    Next i
    strResult = Join(vR, vbCrLf)
    Range("f1").Resize(UBound(vR)) = WorksheetFunction.Transpose(vR)
    '@@ Save Text file
    strFn = "Test1.srt"
    strFn = ThisWorkbook.Path & "\" & strFn

    TransToUTF strResult, strFn 'make srt file
End Sub
Sub TransToUTF(strTxt As String, strFile As String)
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile strFile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

你从别人那里得到了满意的答案，但我更正了我的答案。在工作表上显示结果将非常耗时。它还会添加大量数据。为什么使用数组很好是本网站的重点。参考这个

Sub test()
    Dim vDB, vR()
    Dim s As String, s2 As String, s3 As String
    Dim sT As Integer, sE As Integer, co As Integer
    Dim str As String, strResult As String
    Dim i As Long, n As Long, c As Long, r As Long
    Dim num As Long
    Dim T1 As String, T2 As String
    Dim strFn As String


    s = WorksheetFunction.Rept(Space(1) & vbCrLf, 4) & Space(1)
    s2 = "," & Format(0, "000")
    s3 = WorksheetFunction.Rept(Space(1) & vbCrLf, 4)

    vDB = Range("a1").CurrentRegion
    n = UBound(vDB, 1)
    sT = 1
    For i = 1 To n
        If vDB(i, 2) = "" Then
            num = num + 1
            c = c + 5
            If num = 1 Then
                sE = sT + 4
            Else
                sT = sE + 1
                sE = sT + 9
            End If
            T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
            T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
            ReDim Preserve vR(1 To c)
            vR(c - 4) = num
            vR(c - 3) = T1 & s2 & " --> " & T2 & s2
            vR(c - 2) = s
            vR(c - 1) = vDB(i, 1)
            vR(c) = s3
        Else
            r = r + 1
            If r = 1 Then
                num = num + 1
                c = c + 4
                sT = sE + 1
                sE = sT + 9
                T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
                T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
                ReDim Preserve vR(1 To c)
                vR(c - 3) = num
                vR(c - 2) = T1 & s2 & " --> " & T2 & s2
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf & Space(1)
            Else
                c = c + 2
                 ReDim Preserve vR(1 To c)
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf & Space(1)
                If r = 3 Then r = 0
            End If
        End If
    Next i
    strResult = Join(vR, vbCrLf)
    '@@ This not need. This is just for reviewing the results of the code on the sheet.
        'Range("f1").Resize(UBound(vR)) = WorksheetFunction.Transpose(vR)
    '@@ Save Text file
    strFn = "Test1.srt"
    strFn = ThisWorkbook.Path & "\" & strFn

    TransToUTF strResult, strFn 'make srt file
End Sub
Sub TransToUTF(strTxt As String, strFile As String)
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile strFile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub