|
Функция 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
|
