Получить данные из файла CSV

Question

В Google есть много обращений по этому поводу, но мне интересно, какой самый лучший / самый быстрый способ получить некоторые данные из файла CSV? Некоторые загружают весь файл CSV в Excel, некоторые загружают его в массив. Я видел, что некоторым людям нравится искать определенное c слово.

В основном мне нужно извлечь 4 значения из каждого существующего файла CSV. (время начала / окончания, оборудование и подложка) Обратите внимание, что оборудование будет повторяться несколько раз внутри каждого файла. Остальные 3 уникальны.

Какой метод лучше / быстрее?

Вот небольшой пример файла CSV:

/port_name   A
#data 01
  @slot_no        2
  @m_start 2020/03/26 19:15:27
  @m_end   2020/03/26 19:23:21
  @u_start  ????/??/?? ??:??:??
  @u_end    ????/??/?? ??:??:??
  $result 1 1 -4,-4 2548
    <result_info>    1 : Kind                 : 
    &no_of_image 3
    &i_name 01 S02.tif
     ~i_info    Digital_Zoom            1.0
     ~i_info    Equipment               4000 SERIAL NO. : 31
    &i_name 02 S02.tif
     ~i_info    Digital_Zoom            1.0
     ~i_info    Equipment               4000 SERIAL NO. : 31
~CMS_substrate_id      2 "8939-02"
/end_of_file

Answer 1

Мой ответ похож на @Luuk, но я не проверяю «Оборудование», поскольку оно появляется в данных образца дважды для каждой записи. Вместо этого я проверяю «& i_name 01» и затем пропускаю несколько строк.

Sub sGetData()
    On Error GoTo E_Handle
    Dim strFile As String
    Dim intFile As Integer
    Dim strInput As String
    Dim lngRow As Long
    strFile = "J:\downloads\sample.txt"
    intFile = FreeFile
    Open strFile For Input As intFile
    lngRow = 1
    Do
        Line Input #intFile, strInput
        If InStr(strInput, "@m_start") > 0 Then
            lngRow = lngRow + 1
            ActiveSheet.Cells(lngRow, 1) = Mid(strInput, 12)
        ElseIf InStr(strInput, "@m_end") > 0 Then
            ActiveSheet.Cells(lngRow, 2) = Mid(strInput, 12)
        ElseIf InStr(strInput, "&i_name 01") > 0 Then
            Line Input #intFile, strInput
            Line Input #intFile, strInput
            ActiveSheet.Cells(lngRow, 3) = Mid(strInput, 41, 4)
        ElseIf InStr(strInput, "~CMS_substrate_id") > 0 Then
            ActiveSheet.Cells(lngRow, 4) = Mid(strInput, 24)
        End If
    Loop Until EOF(intFile)
sExit:
    On Error Resume Next
    Reset
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sGetData", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

Поскольку этот файл данных, вероятно, не заканчивается строкой с обычной комбинацией возврата каретки / перевода строки, с которой имеет дело VBA, Я создал новую подпрограмму, которая считывает данные в массив, разбивая на конец используемого символа строки (в данном случае перевод строки) перед его обработкой.

Sub sGetData2()
    On Error GoTo E_Handle
    Dim strFile As String
    Dim intFile As Integer
    Dim strInput As String
    Dim astrData() As String
    Dim lngLoop1 As Long
    Dim lngCount As Long
    Dim lngRow As Long
    strFile = "J:\downloads\sample1.txt"
    intFile = FreeFile
    Open strFile For Input As intFile
    strInput = input(LOF(intFile), intFile)
    astrData() = Split(strInput, vbLf)
    lngCount = UBound(astrData)
    lngRow = 1
    For lngLoop1 = 3 To lngCount
        If InStr(astrData(lngLoop1), "@m_start") > 0 Then
            lngRow = lngRow + 1
            ActiveSheet.Cells(lngRow, 1) = Mid(astrData(lngLoop1), 12)
        ElseIf InStr(astrData(lngLoop1), "@m_end") > 0 Then
            ActiveSheet.Cells(lngRow, 2) = Mid(astrData(lngLoop1), 12)
        ElseIf InStr(astrData(lngLoop1), "&i_name 01") > 0 Then
            lngLoop1 = lngLoop1 + 2
            ActiveSheet.Cells(lngRow, 3) = Mid(astrData(lngLoop1), 41, 4)
        ElseIf InStr(astrData(lngLoop1), "~CMS_substrate_id") > 0 Then
            ActiveSheet.Cells(lngRow, 4) = Mid(astrData(lngLoop1), 24)
        End If
    Next lngLoop1
sExit:
    On Error Resume Next
    Reset
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sGetData2", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

С уважением,

Answer 2

1. Получить строку из вашего текстового файла по объекту adodb.stream.
2. Извлечь то, что вы ищете, из импортированной строки с помощью регулярного выражения.
3. Поместите второе содержимое подспарений извлеченной коллекции совпадений в массив. Элементы экипировки имеют два одинаковых содержимого, поэтому они увеличиваются на два.
4. Данные в массиве переносятся на лист.

---

Sub Test()
    Dim Ws As Worksheet
    Dim Path As String
    Dim s As String
    Dim pattn(1 To 4) As String
    'Dim Match(1 To 4) As MatchCollection
    Dim Match(1 To 4) As Object
    Dim vR() As Variant
    Dim i As Long, n As Long, j As Integer, k As Long

    Path = ThisWorkbook.Path & "\regextest.txt" '<~~ Your text file full Path

    s = getString(Path) '<~~ get text form your text file

    Set Ws = ActiveSheet

    '** This is regular Expression
    pattn(1) = "(m_start[ ]{1,})(\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2})"
    pattn(2) = "(m_end[ ]{1,})(\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2})"
    pattn(3) = "(~i_info    Equipment[ ]{1,})(\d{1,})"
    pattn(4) = "(~CMS_substrate_id[ ]{1,})(\d{1,}[ ]{1,}" & Chr(34) & "\d{1,}-\d{1,}" & Chr(34) & ")"

    For i = 1 To 4
        Set Match(i) = GetRegEx(s, pattn(i))
    Next i

    n = Match(1).Count
    ReDim vR(1 To n, 1 To 4)

    For i = 0 To n - 1
        For j = 1 To 4
            If j = 3 Then
                vR(i + 1, j) = Match(j).Item(k).SubMatches(1)
                k = k + 2
            Else
                vR(i + 1, j) = Match(j).Item(i).SubMatches(1)
            End If
        Next j
    Next i
    With Ws
        .Cells.Clear
        .Range("a1").Resize(1, 4) = Array("m_start", "m_end", "Equipment", "CMS_substrate_id")
        .Range("a2").Resize(n, 4) = vR
        .Range("a:b").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
    End With
End Sub

Function GetRegEx(StrInput As String, strPattern As String) As Object
    'Dim RegEx As New RegExp
    Dim RegEx As Object

    'Set RegEx = New RegExp
    Set RegEx = CreateObject("VBscript.RegExp")
    With RegEx
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
        .Pattern = strPattern
    End With
    If RegEx.Test(StrInput) Then
        Set GetRegEx = RegEx.Execute(StrInput)
    End If
End Function

Function getString(Path As String)
    'Dim objStream As ADODB.Stream
    Dim objStream As Object

    'Set objStream = New ADODB.Stream
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "Utf-8"
        .Open
        .LoadFromFile Path
        getString = .ReadText
        .Close
    End With

End Function

Результат изображения (3 типы данных)

Answer 3

Быстрый запуск макроса может выглядеть следующим образом:

Sub readCSVfile()
    Dim textline As String
    Dim Filename
    Filename = "D:\TEMP\excel\61039635\CSVfile.txt"
    Dim row As Integer

    Cells(1, 1).Value = "m_start"
    Cells(1, 2).Value = "m_end"
    Cells(1, 3).Value = "Equipment"
    Cells(1, 4).Value = "CMS_substrate_id"
    row = 2
    Open Filename For Input As #1
    Do While Not EOF(1)
        Line Input #1, textline
        Select Case True
            Case InStr(textline, "@m_start") > 0:
                Cells(row, 1).Value = mysub(textline, "@m_start")
            Case InStr(textline, "@m_end") > 0:
                Cells(row, 2).Value = mysub(textline, "@m_end")
            Case InStr(textline, "Equipment") > 0:
                Cells(row, 3).Value = mysub(textline, "Equipment")
            Case InStr(textline, "CMS_substrate_id") > 0:
                Cells(row, 4).Value = mysub(textline, "CMS_substrate_id")
                row = row + 1
        End Select

    Loop

    Close (1)

End Sub
Function mysub(t As String, s As String) As String
    mysub = Trim(Mid(t, InStr(t, s) + Len(s) + 1))
End Function