Загрузите файл csv в массив VBA, а не в Excel Sheet

Ответ 1

ОК, посмотрев на это, я решил использовать ADODB (требуется ссылка на объекты ActiveX Data Objects, загружает файл csv в массив без циклирования столбцов строк). Требуется, чтобы данные были в хорошем состоянии.

Sub LoadCSVtoArray()

strPath = ThisWorkbook.Path & "\"

Set cn = CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.Open strcon
strSQL = "SELECT * FROM SAMPLE.csv;"

Dim rs As Recordset
Dim rsARR() As Variant

Set rs = cn.Execute(strSQL)
rsARR = WorksheetFunction.Transpose(rs.GetRows)
rs.Close
Set cn = Nothing

[a1].Resize(UBound(rsARR), UBound(Application.Transpose(rsARR))) = rsARR

End Sub

Ответ 2

Хорошо, похоже, вам нужны две вещи: потоковая передача данных из файла и заполнение двумерного массива.

У меня есть функции Join2d и Split2d (я помню, как опубликовал их в другом ответе на Qaru некоторое время назад). Посмотрите на комментарии в коде, есть вещи, которые вам, возможно, нужно знать об эффективной обработке строк, если вы работаете с большими файлами.

Однако это не сложная функция: просто вставьте код, если вы спешите.

Потоковая передача файла проста, НО мы делаем предположения относительно формата файла: строки в файле разделены символами Carriage-Return или парой символов Carriage-Return-and-Linefeed? Я предполагаю "CR", а не CRLF, но вы должны это проверить.

Другое предположение о формате заключается в том, что числовые данные будут отображаться как есть, а строковые или символьные данные будут заключены в кавычки. Это должно быть правдой, но часто это не так... И удаление кавычек добавляет большую обработку - много строк выделения и освобождения - что вы действительно не хотите делать в большом массиве. Я сократил очевидный поиск и замену ячейки за ячейкой, но это все еще проблема с большими файлами.

В любом случае: здесь исходный код: обратите внимание на разрывы строк, вставленные элементом управления текстовым полем Qaru:

Выполнение кода:

Обратите внимание, что вам понадобится ссылка на среду выполнения сценариев Microsoft (system32\scrrun32.dll)

Private Sub test()
    Dim arrX As Variant
    arrX = ArrayFromCSVfile("MyFile.csv")
End Sub

Потоковый CSV файл.

Обратите внимание, что я предполагаю, что ваш файл находится во временной папке:  C:\Документы и настройки [$ USERNAME]\Локальные настройки \Temp Вам нужно будет использовать команды файловой системы, чтобы скопировать файл в локальную папку: это всегда быстрее, чем работа по сети.

Public Function ArrayFromCSVfile( _
    strName As String, _
    Optional RowDelimiter As String = vbCr, _
    Optional FieldDelimiter = ",", _
    Optional RemoveQuotes As Boolean = True _
) As Variant

    ' Load a file created by FileToArray into a 2-dimensional array
    ' The file name is specified by strName, and it is exected to exist
    ' in the user temporary folder. This is a deliberate restriction:
    ' it always faster to copy remote files to a local drive than to
    ' edit them across the network

    ' RemoveQuotes=TRUE strips out the double-quote marks (Char 34) that
    ' encapsulate strings in most csv files.

    On Error Resume Next

    Dim objFSO As Scripting.FileSystemObject
    Dim arrData As Variant
    Dim strFile As String
    Dim strTemp As String

    Set objFSO = New Scripting.FileSystemObject
    strTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPath
    strFile = objFSO.BuildPath(strTemp, strName)
    If Not objFSO.FileExists(strFile) Then  ' raise an error?
        Exit Function
    End If

    Application.StatusBar = "Reading the file... (" & strName & ")"

    If Not RemoveQuotes Then
        arrData = Join2d(objFSO.OpenTextFile(strFile, ForReading).ReadAll, RowDelimiter, FieldDelimiter)
        Application.StatusBar = "Reading the file... Done"
    Else
        ' we have to do some allocation here...

        strTemp = objFSO.OpenTextFile(strFile, ForReading).ReadAll
        Application.StatusBar = "Reading the file... Done"

        Application.StatusBar = "Parsing the file..."

        strTemp = Replace$(strTemp, Chr(34) & RowDelimiter, RowDelimiter)
        strTemp = Replace$(strTemp, RowDelimiter & Chr(34), RowDelimiter)
        strTemp = Replace$(strTemp, Chr(34) & FieldDelimiter, FieldDelimiter)
        strTemp = Replace$(strTemp, FieldDelimiter & Chr(34), FieldDelimiter)

        If Right$(strTemp, Len(strTemp)) = Chr(34) Then
            strTemp = Left$(strTemp, Len(strTemp) - 1)
        End If

        If Left$(strTemp, 1) = Chr(34) Then
            strTemp = Right$(strTemp, Len(strTemp) - 1)
        End If

        Application.StatusBar = "Parsing the file... Done"
        arrData = Split2d(strTemp, RowDelimiter, FieldDelimiter)
        strTemp = ""
    End If

    Application.StatusBar = False

    Set objFSO = Nothing
    ArrayFromCSVfile = arrData
    Erase arrData
End Function

Split2d Создает 2-мерный массив VBA из строки:

Public Function Split2d(ByRef strInput As String, _
    Optional RowDelimiter As String = vbCr, _
    Optional FieldDelimiter = vbTab, _
    Optional CoerceLowerBound As Long = 0 _
    ) As Variant

    ' Split up a string into a 2-dimensional array.

    ' Works like VBA.Strings.Split, for a 2-dimensional array.
    ' Check your lower bounds on return: never assume that any array in
    ' VBA is zero-based, even if you've set Option Base 0
    ' If in doubt, coerce the lower bounds to 0 or 1 by setting
    ' CoerceLowerBound
    ' Note that the default delimiters are those inserted into the
    '  string returned by ADODB.Recordset.GetString

    On Error Resume Next

    ' Coding note: we're not doing any string-handling in VBA.Strings -
    ' allocating, deallocating and (especially!) concatenating are SLOW.
    ' We're using the VBA Join & Split functions ONLY. The VBA Join,
    ' Split, & Replace functions are linked directly to fast (by VBA
    ' standards) functions in the native Windows code. Feel free to
    ' optimise further by declaring and using the Kernel string functions
    ' if you want to.

    ' ** THIS CODE IS IN THE PUBLIC DOMAIN **
    '    Nigel Heffernan   Excellerando.Blogspot.com

    Dim i   As Long
    Dim j   As Long

    Dim i_n As Long
    Dim j_n As Long

    Dim i_lBound As Long
    Dim i_uBound As Long
    Dim j_lBound As Long
    Dim j_uBound As Long

    Dim arrTemp1 As Variant
    Dim arrTemp2 As Variant

    arrTemp1 = Split(strInput, RowDelimiter)

    i_lBound = LBound(arrTemp1)
    i_uBound = UBound(arrTemp1)

    If VBA.LenB(arrTemp1(i_uBound)) <= 0 Then
        ' clip out empty last row: a common artifact in data
         'loaded from files with a terminating row delimiter
        i_uBound = i_uBound - 1
    End If

    i = i_lBound
    arrTemp2 = Split(arrTemp1(i), FieldDelimiter)

    j_lBound = LBound(arrTemp2)
    j_uBound = UBound(arrTemp2)

    If VBA.LenB(arrTemp2(j_uBound)) <= 0 Then
     ' ! potential error: first row with an empty last field...
        j_uBound = j_uBound - 1
    End If

    i_n = CoerceLowerBound - i_lBound
    j_n = CoerceLowerBound - j_lBound

    ReDim arrData(i_lBound + i_n To i_uBound + i_n, j_lBound + j_n To j_uBound + j_n)

    ' As we've got the first row already... populate it
    ' here, and start the main loop from lbound+1

    For j = j_lBound To j_uBound
        arrData(i_lBound + i_n, j + j_n) = arrTemp2(j)
    Next j

    For i = i_lBound + 1 To i_uBound Step 1

        arrTemp2 = Split(arrTemp1(i), FieldDelimiter)

        For j = j_lBound To j_uBound Step 1
            arrData(i + i_n, j + j_n) = arrTemp2(j)
        Next j

        Erase arrTemp2

    Next i

    Erase arrTemp1

    Application.StatusBar = False

    Split2d = arrData

End Function

Join2D Превращает двумерный массив VBA в строку:

Public Function Join2d(ByRef InputArray As Variant, _
    Optional RowDelimiter As String = vbCr, _
    Optional FieldDelimiter = vbTab, _
    Optional SkipBlankRows As Boolean = False _
    ) As String

    ' Join up a 2-dimensional array into a string. Works like the standard
    '  VBA.Strings.Join, for a 2-dimensional array.
    ' Note that the default delimiters are those inserted into the string
    '  returned by ADODB.Recordset.GetString

    On Error Resume Next

    ' Coding note: we're not doing any string-handling in VBA.Strings -
    ' allocating, deallocating and (especially!) concatenating are SLOW.
    ' We're using the VBA Join & Split functions ONLY. The VBA Join,
    ' Split, & Replace functions are linked directly to fast (by VBA
    ' standards) functions in the native Windows code. Feel free to
    ' optimise further by declaring and using the Kernel string functions
    ' if you want to.

    ' ** THIS CODE IS IN THE PUBLIC DOMAIN **
    '   Nigel Heffernan   Excellerando.Blogspot.com

    Dim i As Long
    Dim j As Long

    Dim i_lBound As Long
    Dim i_uBound As Long
    Dim j_lBound As Long
    Dim j_uBound As Long

    Dim arrTemp1() As String
    Dim arrTemp2() As String

    Dim strBlankRow As String

    i_lBound = LBound(InputArray, 1)
    i_uBound = UBound(InputArray, 1)

    j_lBound = LBound(InputArray, 2)
    j_uBound = UBound(InputArray, 2)

    ReDim arrTemp1(i_lBound To i_uBound)
    ReDim arrTemp2(j_lBound To j_uBound)

    For i = i_lBound To i_uBound

        For j = j_lBound To j_uBound
            arrTemp2(j) = InputArray(i, j)
        Next j

        arrTemp1(i) = Join(arrTemp2, FieldDelimiter)

    Next i

    If SkipBlankRows Then

        If Len(FieldDelimiter) = 1 Then
            strBlankRow = String(j_uBound - j_lBound, FieldDelimiter)
        Else
            For j = j_lBound To j_uBound
                strBlankRow = strBlankRow & FieldDelimiter
            Next j
        End If

        Join2d = Replace(Join(arrTemp1, RowDelimiter), strBlankRow, RowDelimiter, "")
        i = Len(strBlankRow & RowDelimiter)

        If Left(Join2d, i) = strBlankRow & RowDelimiter Then
            Mid$(Join2d, 1, i) = ""
        End If

    Else

        Join2d = Join(arrTemp1, RowDelimiter)

    End If

    Erase arrTemp1

End Function

Делись и наслаждайся.

Ответ 3

Да прочитайте его как текстовый файл.

См. этот пример

Option Explicit

Sub Sample()
    Dim MyData As String, strData() As String

    Open "C:\MyFile.CSV" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
End Sub

Followup

Как я упоминал ниже в комментариях, AFAIK, нет прямого способа заполнить 2d-массив из csv. Вам придется использовать код, который я дал выше, а затем разделить его на строку и, наконец, заполнить 2D-массив, который может быть громоздким. Заполнение столбца легко, но если вы специально хотите сказать от строк от 5 до полных данных, то это становится громоздким, так как вам нужно будет проверить, есть ли в столбцах достаточное количество столбцов/строк. Вот базовый пример, чтобы получить Col B в двумерном массиве.

ПРИМЕЧАНИЕ. Я не выполнял обработку ошибок. Я уверен, что вы можете позаботиться об этом.

Скажем, наш CSV файл выглядит так.

При запуске этого кода

Option Explicit

Const Delim As String = ","

Sub Sample()
    Dim MyData As String, strData() As String, TmpAr() As String
    Dim TwoDArray() As String
    Dim i As Long, n As Long

    Open "C:\Users\Siddharth Rout\Desktop\Sample.CSV" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)

    n = 0

    For i = LBound(strData) To UBound(strData)
        If Len(Trim(strData(i))) <> 0 Then
            TmpAr = Split(strData(i), Delim)
            n = n + 1
            ReDim Preserve TwoDArray(1, 1 To n)
            '~~> TmpAr(1) : 1 for Col B, 0 would be A
            TwoDArray(1, n) = TmpAr(1)
        End If
    Next i

    For i = 1 To n
        Debug.Print TwoDArray(1, i)
    Next i
End Sub

Вы получите результат, как показано ниже

Кстати, мне интересно, что, поскольку вы делаете это в Excel, почему бы не использовать встроенный метод Workbooks.Open или QueryTables, а затем прочитать диапазон в 2D-массив? Это было бы намного проще...

Ответ 4

В качестве альтернативы вы можете использовать такой код

Dim line As String, Arr
Dim FSO As FileSystemObject, Fo As TextStream
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fo = FSO.OpenTextFile("csvfile.csv")
While Not Fo.AtEndOfStream
 line = Fo.ReadLine      ' Read the csv file line by line
 Arr = Split(line, ",")  ' The csv line is loaded into the Arr as an array
 For i = 0 To UBound(Arr) - 1: Debug.Print Arr(i) & " ";: Next
 Debug.Print
Wend

 01/01/2019 1 1 1 36 55.6 0.8 85.3 95 95 109 102 97 6 2.5 2.5 3.9 
 01/01/2019 1 2 0 24 0.0 2.5 72.1 89 0 0 97 95 10 6.7 4.9 3.9 
 01/01/2019 1 3 1 36 26.3 4 80.6 92 92 101 97 97 8 5.5 5.3 3.7 
 01/01/2019 1 4 0 16 30.0 8 79.2 75 74 87 87 86 10 3.8 4 4.2 

Ответ 5

Чтобы получить файл данных CSV известного формата в 2D-массив, я, наконец, принял следующий метод, который, кажется, работает хорошо и довольно быстро. Я решил, что в настоящее время операции чтения файлов выполняются довольно быстро, поэтому я выполнил первый проход файла csv, чтобы получить размер, необходимый для обоих измерений массива. С соответствующим размером массива, это простая задача, перечитать файл, построчно и заполнить массив.

Function ImportTestData(ByRef srcFile As String, _
                        ByRef dataArr As Variant) _
                        As Boolean

Dim FSO As FileSystemObject, Fo As TextStream
Dim line As String, Arr As Variant
Dim lc As Long, cc As Long
Dim i As Long, j As Long

ImportTestData = False
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Fo = FSO.OpenTextFile(srcFile)

' First pass; read the file to get array size
lc = 0 ' Counter for number of lines in the file
cc = 0 ' Counter for number of columns in the file
While Not Fo.AtEndOfStream  ' Read the csv file line by line
    line = Fo.ReadLine
    If lc = 0 Then ' Count commas to get array 2nd dim index
        cc = 1 + Len(line) - Len(Replace(line, ",", ""))
    End If
    lc = lc + 1
Wend
Fo.Close

' Set array dimensions to accept file contents
ReDim dataArr(0 To lc - 1, 0 To cc - 1)
'Debug.Print "CSV has "; n; " rows with "; lc; " fields/row"
If lc > 1 And cc > 1 Then
    ImportTestData = True
End If

' Second pass; Re-open data file and copy to array
Set Fo = FSO.OpenTextFile(srcFile)
lc = 0
While Not Fo.AtEndOfStream
    line = Fo.ReadLine
    Arr = Split(line, ",")
    For i = 0 To UBound(Arr)
        dataArr(lc, i) = Arr(i)
    Next i
    lc = lc + 1
Wend

End Function   'ImportTestData()

Я создал это как функцию, а не как Sub, чтобы получить простое возвращаемое значение, если это необходимо. Чтение файла с 8500 строками из 20 столбцов занимает приблизительно 180 мс.
Этот метод предполагает, что структура (количество разделителей) файла CSV одинакова для каждой строки, что типично для приложения регистрации данных.

Ответ 6

Следующее решение не использует ActiveX:

Я написал код для импорта файла CSV (фактически разделенных табуляцией) в массив. Этот код следующий.

Сначала позвольте обозначить массив (изначально он полностью пуст, но позже он будет соответственно изменен):

Dim TxtFile$()

Теперь для подпроцедуры:

' Fills TxtFile$() array
Sub FillTextFileArray(A$)

'***********************************************************************
' Declarations
'***********************************************************************
Dim I, J As Integer
Dim LineString As String
'***********************************************************************

I = -1: J = 0    ' Will hold array dimentions

Open A$ For Input As #1

Do While Not EOF(1)    ' Loop until end of file.
    Line Input #1, LineString
    LineString = LineString + vbTab    ' If not done empty lines give error with Split()
    I = I + 1
    If J < UBound(Split(LineString, vbTab)) Then J = UBound(Split(LineString, vbTab))
Loop

ReDim TxtFile$(1 To I + 4, 1 To J + 4)    ' Not indexed from 0 ! (Plus some room at the end.) This is done to match worksheet format.
Seek #1, 1    ' Reset to start

I = -1    ' Will hold array row index
Do While Not EOF(1)    ' Loop until end of file.
    Line Input #1, LineString
    LineString = LineString + vbTab    ' If not done empty lines give error with Split()
    I = I + 1
    For J = 0 To UBound(Split(LineString, vbTab))
        TxtFile$(I + 1, J + 1) = Split(LineString, vbTab)(J)
    Next J
Loop

Close #1    ' Close file.

' TxtFile$() now holds the contents of the text file

End Sub

Очевидно, что вы можете делать то, что вы хотите с массивом TxtFile $. $ - это местоположение и имя текстового файла. Как уже говорилось, этот конкретный код работает с файлами с разделителями табуляции (vbTab), а не с разделителями-запятыми (разделенными), но любая адаптация не должна быть слишком сложной. Он имеет преимущество в том, что избегает осложнений ActiveX.