Преобразование табличных данных в формат текстового файла субтитров (.srt) UTF-8

Question

У меня есть данные по фондовому рынку в Excel, которые я хочу преобразовать в текстовый файл с кодировкой UTF-8 и расширением .srt, что, по-моему, является очень сложной задачей для меня.Я знаю, как преобразовать файл Excel в текстовый файл, но в этом случае обработка должна быть выполнена перед преобразованием, и это кажется немного беспокойным.Что мне нужно сделать, это привести табличные данные в один столбец (один под другим) с учетом нескольких правил.Я не знаю, как объяснить мой запрос в тексте, и именно поэтому я прилагаю скриншот файла Excel.На прилагаемом скриншоте файла Excel табличные данные выделены зеленым цветом, а способ преобразования преобразованных данных - желтым.Инструкции по обработке данных написаны синим текстом.

Это только примерные данные.Исходные данные будут больше по размеру.В выборочных данных под заголовком Акции есть 6 компаний, во Взаимных фондах, 1 компания и в иностранной валюте - 1, но в реальных данных было бы больше категорий и больше данных в каждой категории (в выборочных данных есть только 3категории).Может кто-нибудь подсказать мне, как этого можно достичь в Excel VBA

Я опубликовал это в excelforum, но не получил никакого ответа.Ценю некоторую помощь. Ссылка на ExcelForum здесь

Спасибо

Спасибо.

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

Answer 2

Вы можете протестировать этот код, я проверил его на предоставленных вами данных, но для ваших реальных данных он может потребовать незначительных корректировок;Я верю, что вы можете сделать это.

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