Question

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

这只是示例数据。原始数据将更大。在“股权”标题下的样本数据中，有6家公司，在“共同基金”下，有1家公司，在“外汇”下，有1家公司，但在实际数据中，会有更多类别，并且每个类别中的数据也更多（在样本数据中只有3家类别）。有人可以帮我推动一下如何在Excel VBA中实现吗

我将此内容发布在excelforum上，但未收到任何回复。感谢一些帮助。 ExcelForum link here

谢谢

谢谢。

Answer 1

您可以测试此代码，我已经在您提供的数据上对其进行了测试，但是对于您的实际数据，可能需要进行一些小的调整；我相信你可以做到。

Sub extract_data()

    Dim i, j, data_row As Long
    Dim serial_num As Long
    Dim time_start, time_end As Double

    time_start = TimeSerial(0, 0, 1)
    time_end = TimeSerial(0, 0, 5)

    time_str = Format(time_start, "HH:MM:SS") & ",000 --> " & Format(time_end, "HH:MM:SS") & ",000"

    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    serial_num = 1

    data_row = 1

    For i = 1 To lastRow

        If Range("B" & i).Value = "" Then

            Range("F" & data_row).Value = serial_num
            serial_num = serial_num + 1
            data_row = data_row + 1
            Range("F" & data_row).Value = time_str
            data_row = data_row + 6
            Range("F" & data_row).Value = Range("A" & i).Value
            data_row = data_row + 6
        Else

            Range("F" & data_row).Value = serial_num
            serial_num = serial_num + 1
            data_row = data_row + 1
            time_start = time_end + TimeSerial(0, 0, 1)
            time_end = time_start + TimeSerial(0, 0, 9)
            time_str = Format(time_start, "HH:MM:SS") & ",000 --> " & Format(time_end, "HH:MM:SS") & ",000"
            Range("F" & data_row).Value = time_str


            For j = i To i + 2

                data_row = data_row + 1
                Range("F" & data_row).Value = Range("A" & j).Value

                high_low_close = "High : " & Range("B" & j).Value & " " & _
                                 "Low : " & Range("C" & j).Value & " " & _
                                 "Close : " & Range("D" & j).Value

                data_row = data_row + 1
                Range("F" & data_row).Value = high_low_close
                data_row = data_row + 1

            Next

            i = j - 1
            data_row = data_row + 1

         End If

   Next

End Sub

Answer 2

尝试

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

您从其他人那里得到了满意的答案，但是我更正了我的答案。在工作表上显示结果将很耗时。它还将添加大量数据。为什么使用数组好是该站点的重点。请参阅This

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

将表格数据转换为字幕文本文件格式（.srt）UTF-8

2 个答案: