Функция TextFile2Array предназначена для преобразования файла CSV в двумерный массив

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

Чтобы упростить весь процесс - от выбора файла CSV в диалоговом окне, до разбиения загруженного из файла текста в двумерный массив, и была написана эта функция.

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

Пример использования функции для загрузки данных из файла CSV:

Sub ЗагрузкаДанныхИзCSV()

' выбор файла по умолчанию предлагается в той же папке,

' где расположен текущий файл Excel

CSVarr = TextFile2Array(, ThisWorkbook.Path, , "*.csv")

' проверка результата загрузки данных (выход из макроса, если данные не загружены)

If Not IsArray(CSVarr) Then MsgBox "Файл CSV не обработан", vbCritical, "Ошибка": Exit Sub

' ваш код обработки двумерного массива

Debug.Print "Загружен двумерный массив размерами " & _

UBound(CSVarr, 1) & " строк на " & UBound(CSVarr, 2) & " столбцов"

End Sub

Результат в окне Immediate:

Загружен двумерный массив размерами 1244 строк на 9 столбцов

Код функции TextFile2Array:

Function TextFile2Array(Optional ByVal Title As String = "Выберите файл для обработки", _

Optional ByVal InitialPath As String = "c:\", _

Optional ByVal FilterDescription As String = "Текстовые файлы", _

Optional ByVal FilterExtention As String = "*.*", _

Optional ByVal ColumnsSeparator$ = ";", _

Optional ByVal RowsSeparator$ = vbNewLine) As Variant

' Функция запрашивает имя файла (текстового, CSV, и т.п.), и обрабатывает его содержимое

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

' Возвращает двумерный массив - результат преобразования текстового файла в двумерный массив

On Error Resume Next

With Application.FileDialog(msoFileDialogOpen) ' диалоговое окно выбора файла CSV

.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath

.Filters.Clear: .Filters.Add FilterDescription, FilterExtention

If .Show <> -1 Then Exit Function

Filename$ = .SelectedItems(1)

End With

Set fso = CreateObject("scripting.filesystemobject") ' читаем текст из выбранного файла

Set ts = fso.OpenTextFile(Filename$, 1, True): txt$ = ts.ReadAll: ts.Close

Set ts = Nothing: Set fso = Nothing

txt = Trim(txt): Err.Clear ' разделяем текст на строки и столбцы

If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))

tmpArr1 = Split(txt, RowsSeparator$): RowsCount = UBound(tmpArr1) + 1

ColumnsCount = UBound(Split(tmpArr1(0), ColumnsSeparator$)) + 1

If Err.Number > 0 Then MsgBox "Строка не может быть разбита на двумерный массив", vbCritical: End

ReDim arr(1 To RowsCount, 1 To ColumnsCount)

For i = LBound(tmpArr1) To UBound(tmpArr1)

tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator$)

For j = 1 To UBound(tmpArr2)+1

arr(i + 1, j) = tmpArr2(j - 1)

Next j

Next i

TextFile2Array = arr ' возвращаем результат в виде двумерного массива

End Function

Ещё одна функция, - без вывода диалогового окна выбора файла

Function LoadArrayFromTextFile(ByVal filename$, Optional ByVal FirstRow& = 1, _

Optional ByVal ColumnsSeparator$ = ";", Optional ByVal RowsSeparator$ = vbNewLine) As Variant

' Функция открывает текстовый (CSV) файл filename$,

' и загружает макссив данных, начиная со строки FirstRow&

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

' Возвращает двумерный массив - результат преобразования текстового файла в двумерный массив

On Error Resume Next

Set FSO = CreateObject("scripting.filesystemobject") ' читаем текст из выбранного файла

Set ts = FSO.OpenTextFile(filename$, 1, True): txt$ = ts.ReadAll: ts.Close

Set ts = Nothing: Set FSO = Nothing

txt = Trim(txt): Err.Clear ' разделяем текст на строки и столбцы

If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))

If FirstRow& > 1 Then ' обрезаем ненужные строки

txt = Split(txt, RowsSeparator$, FirstRow&)(FirstRow& - 1)

End If

Err.Clear: tmpArr1 = Split(txt, RowsSeparator$): RowsCount = UBound(tmpArr1) + 1

ColumnsCount = UBound(Split(tmpArr1(0), ColumnsSeparator$)) + 1

If Err.Number > 0 Then MsgBox "Текст файла " & Dir(filename$, vbNormal) & _

" не может быть считан в двумерный массив", vbCritical: Exit Function

ReDim arr(1 To RowsCount, 1 To ColumnsCount)

For i = LBound(tmpArr1) To UBound(tmpArr1)

tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator$)

For j = 1 To UBound(tmpArr2) + 1

arr(i + 1, j) = tmpArr2(j - 1)

Next j

Next i

LoadArrayFromTextFile = arr ' возвращаем результат в виде двумерного массива

End Function

• 25034 просмотра