Создайте CSV-файл, используя текстовый файл с макросом Excel

Question

Используя текстовый файл, который содержит в столбце 3 значение в виде часа, я хотел бы создать файл CSV с помощью макроса Excel.

Цель состоит в том, чтобы создать файл CSV (3 строки), который конкурирует.

1 line = minimum and maximum value in column 3
2 line = write in 24 columns ( 0,1,2,3,4,5 ect )
3 line = count values for each hour, if no value is found for specific hour.. then print 0

Входной файл

123 3 04
122 3 03
122 3 03
122 3 04
122 4 04
122 5 05
122 3 12
122 4 15
122 5 21
122 5 20
122 5 20

Требуемый вывод

3,21
0,1,2,3,4,5,6,7,8,9,10,11,12,13,15,16,17,18,19,20,21,22,23
0,0,0,2,3,1,0,0,0,0,0,0,1,0,0,1,0,0,0,0,2,1,0,0

Заранее спасибо.

Answer 1

Я получил желаемый результат, используя следующий макрос,

Sub Macro1()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    Set l1 = ThisWorkbook
    ruta = l1.Path & "\"
    arch = "file.txt"
    Workbooks.OpenText Filename:=ruta & arch & ".txt", _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, _
        Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Set l2 = ActiveWorkbook
    Set h2 = l2.Sheets(1)
    Set h3 = l2.Sheets.Add
    h3.Cells(1, "A").Value = WorksheetFunction.Min(h2.Columns("C"))
    h3.Cells(1, "B").Value = WorksheetFunction.Max(h2.Columns("C"))
    For i = 0 To 23
        h3.Cells(2, i + 1).Value = i
        h3.Cells(3, i + 1).Value = WorksheetFunction.CountIf(h2.Columns("C"), i)
    Next
    l2.SaveAs Filename:=ruta & arch & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    l2.Close False
    MsgBox "File CSV created", vbInformation
End Sub

Answer 2

Попробуйте

Sub test()
    Dim Path As String, Fn As String
    Dim vDB, vR(), vText1(), vText2()
    Dim wf As WorksheetFunction
    Dim rngDB As Range
    Dim strResult As String
    Dim myMin As Integer, myMax As Integer
    Dim i As Long


    Set rngDB = Range("c1", Range("c" & Rows.Count).End(xlUp))
    Set wf = WorksheetFunction

    vDB = Range("a1").CurrentRegion


    ReDim vR(1 To 3)

    myMin = wf.Min(rngDB)
    myMax = wf.Max(rngDB)
    vR(1) = myMin & "," & myMax
    ReDim vText1(23): ReDim vText2(23)
    For i = 0 To 23
        vText1(i) = i
        vText2(i) = wf.CountIf(rngDB, i)
    Next i
    vR(2) = Join(vText1, ",")
    vR(3) = Join(vText2, ",")
    strResult = Join(vR, vbCrLf)

    Path = ThisWorkbook.Path & "\"
    Fn = "test1.csv"
    Fn = Path & Fn
    TransToCsv strResult, Fn
End Sub
Sub TransToCsv(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