mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Сбор данных из множества текстовых файлов с разделителями

К примеру, есть у вас несколько десятков (или сотен) текстовых файлов с подобным содержимым:
(количество файлов, и количество строк данных в каждом файле не ограничено)

1c04;1J0-698-151-G;1 комплект тормозных накладок;1J0698151G;1J0698151G;5;1
1c04;1H0698151A;Тормозные колодки;1H0698151A;1H0698151A;1;1
1c04;1K0-698-151-B;Тормозные колодки;1K0698151B;1K0698151B;2;1

А надо из всего этого сформировать табличку в Excel - приблизительно такого вида:

Пример таблицы в Excel

На помощь придёт функция DATfolder2Array

Sub ПримерИспользованияФункции_DATfolder2Array()
    Папка = "D:\Проекты\DATs\"    ' папка, в которой будет производиться поиск файлов DAT для обработки
    Dim ErrorsArray    ' пустой массив для ошибок

    ' считываем данные из все файлов .DAT в папке в двумерный массив
    DataArr = DATfolder2Array(Папка, 7, "1,2,4,5", ErrorsArray)
 
    ' результаты выводим на листы "errors" и "result" (они должны существовать)
    Array2worksheet Worksheets("errors"), ErrorsArray, _
                    Array("Имя файла", "Номер строки", "Данные из строки")
    Array2worksheet Worksheets("result"), DataArr, _
                    Array("Ячейка", "Штрих-Код", "Наименование", "код 1С", "код произв.", "кол-во", "счетовод")
End Sub

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

Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
                         ByVal TextColumns$, ByRef ErrorsArr) As Variant
    ' получает путь FolderPath$ к папке с DAT-файлами
    ' считывает из файлов все строки, в которых число записей в строке равно ColumnsCount
    ' остальные (неподходящие) строки отправляет в массив ErrorsArr
    ' (столбцы ErrorsArr: 1-имя файла, 2 - номер строки, 3 - данные)
    ' в переменной TextColumns$ через запятую перечислены номера ТЕКСТОВЫХ столбцов
    ' Возвращает двумерный массив размером N*ColumnsCount

    ReDim ErrorsArr(1 To 1000, 1 To ColumnsCount + 2)
    On Error Resume Next
 
    Dim coll As New Collection, filename
    filename = Dir(FolderPath$ & "*.dat")
    While filename <> ""
        coll.Add filename    ' считываем в колекцию coll нужные имена файлов
        filename = Dir
    Wend
 
    Dim newtxt As String, ro As String, errIndex As Long
    For Each filename In coll
        Application.StatusBar = "Обрабатывается файл: " & filename
        newtxt = ReadTXTfile(FolderPath$ & filename)
        tempArr = "": tempArr = Split(newtxt, vbNewLine)
        For i = LBound(tempArr) To UBound(tempArr)
            ro = tempArr(i): ro = Replace(ro, vbTab, ";")
            If UBound(Split(ro, ";")) <> ColumnsCount - 1 And Len(Trim(ro)) > 0 Then
                tempArr(i) = "": errIndex = errIndex + 1
                ErrorsArr(errIndex, 1) = filename
                ErrorsArr(errIndex, 2) = "Строка " & i + 1
                ErrorsArr(errIndex, 3) = ro
            End If
        Next i
        newtxt = Join(tempArr, vbNewLine)
        txt = txt & newtxt & vbNewLine: DoEvents
    Next
    While InStr(1, txt, vbNewLine & vbNewLine) > 0
        txt = Replace(txt, vbNewLine & vbNewLine, vbNewLine)
    Wend
 
    txt = Replace(txt, vbTab, ";"): tempArr = Split(txt, vbNewLine)
    ReDim newArr(1 To UBound(tempArr), 1 To ColumnsCount)
 
    For i = LBound(tempArr) To UBound(tempArr)
        roArr = "": roArr = Split(tempArr(i), ";")
        For j = 1 To ColumnsCount
            newArr(i + 1, j) = roArr(j - 1)
            If "," & TextColumns$ & "," Like "*," & j & ",*" Then
                newArr(i + 1, j) = "'" & newArr(i + 1, j)
            End If
        Next j
    Next i
    DATfolder2Array = newArr
    Application.StatusBar = False
End Function

Код вспомогательной функции Array2worksheet можно найти на странице http://excelvba.ru/code/Array2worksheet

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Боже какой кошмар: запускать многосотмегабайтное чудище Excel с бэйском для такой задачи. С этим значительно быстрее справится, например, perl.

Большое спасибо за Ваши разработки.

Здравствуйте, Иван.
В вашем случае нужен совсем другой, более сложный, макрос. Можем сделать под заказ.

1c04;1J0-698-151-G;1 комплект тормозных накладок;1J0698151G;1J0698151G;5;1
1c04;1H0698151A;Тормозные колодки;1H0698151A;1H0698151A;1;1
1c04;1K0-698-151-B;Тормозные колодки;1K0698151B;1K0698151B;2;1
----------------------------
добрый день, у меня есть файл с таким же синтаксисом, но в разных строках "столбцы" могут идти в разном порядке ,т.е. атрибут1;значение атрибута1;атрибут2;значание атрибута2;атрибут3;значение атрибута3;
а в следующей строке уже будет атрибут1;значение атрибута1;атрибут3;значение атрибута3;атрибут2;значание атрибута2;
и при экспорте в ексель(открыть как,с использованием разделителей ";"), получается что в столбиках идут разные данные, т.е. атрибуты и их значения в строке идут последовательно и соответствуют друг другу, но если смотреть по столбцу, то может под значением атрибута2, быть значение атрибута3.
как можно дополнить Ваш макрос, чтоб он брал атрибут, выбирал следующие за ним значение, и заносил в другой лист в определенную колонку?

Нет, там функция считывает файл целиком
Если требуется частично файл загружать - это надо другой макрос делать

Спасибо за ответ.
По ходу возник еще вопрос: с помощью функции ReadTXTfile можно выбрать не все строки файла, а только определенные (скажем со 2 по 20)

Здравствуйте, Владимир
Код написан под разделитель столбцов ; (точка с запятой)
Поменяйте в коде ; на , — и всё

Всего в 2 строках надо поменять:

ro = tempArr(i): ro = Replace(ro, vbTab, ";")
If UBound(Split(ro, ";")) <> ColumnsCount - 1 And Len(Trim(ro)) > 0 Then

Добрый день, подскажите если не сложно.
В файлах данные разделяются при помощи - ","
Сложно переделать ваш код для того что бы он распознавал такое разделение?

Беру свои слова обратно, все работает

Пробовал запустить выполнение макроса на сбор данных из несколькоих txt файлов в Excel, но ничего не получается. Нельзя ли выложить пример рабочего файла?

Аналогичная проблема, не могу делать удобоваримым под CSV.
У меня тоже с прибора каждые 3 часа файл вылазит.

Я так понимаю что для импорта файлов с таким форматом строки достаточно в коде сделать так: ' считываем данные из все файлов .DAT в папке в двумерный массив
DataArr = CSVfolder2Array(ПапкаДляФайлов$, 66, "2", ErrorsArray), однако импорта не происходит.

А именно и будет много однотипных файлов: каждые сутки прибор формирует CSV файл с именем типа дд_мм_гг.scv, и строки типа:(22:31:35;Time; 1,02400e+03;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;) т.е. время,служебная информация и далее непосредственно данные до 64 значений. Требуется импорт столбца времени и столбцов данных из этих файлов, но при этом в Excel первым столбцом должна быть еще и дата из имени файла или должен создаваться новый лист с именем файла, т.е. датой.

А почему вы решили взять за основу именно этот макрос?
Этот код предназначен для сложной обработки папки с однотипными файлами,
а для одиночного файла макрос подойдёт попроще.

У меня на сайте много примеров таких макросов - выбирайте любой.
Например, можете взять за основу макрос загрузки CSV в Excel

Есть CSV файл состоящий из 66 столбцов, как изменить макрос чтобы импортировать данные из файла?

не показывает то что нужно,я не пойму где в этом макросе указывать строчки которые нужны из документов

Мой макрос загружает ВСЕ строки из текстовых файлов

(а в примере, ссылку на который я дал в предыдущем комментарии, - все строки, кроме первых)

 

Более того, при вызове функции нужно указывать количество загружаемых столбцов.

К тому же, этот код не универсальный - прямо в функции прописаны разделители строк и полей (точка с запятой, и перевод строки)

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

В другой статье я выложил пример использования этого макроса:

http://excelvba.ru/code/DownloadCSV

(смотрите пример №2 - нажатием первой (зеленой) кнопки скачаете файлы, а нажатием второй (желтой) кнопки, загрузите данные из файлов CSV на лист)

У меня тож не показывает то что нужно,я не пойму где в этом макросе указывать строчки которые нужны из документов,может в этом все дело....

Может и хороший макрос, но.. Увы, не работает...

Добавьте ниже этого макроса код функции ReadTXTfile, взяв его здесь:

http://excelvba.ru/code/txt

эту ошибку исправил, теперь пишет что команда не существует в этом месте newtxt = ReadTXTfile(FolderPath$ & filename)именно чтение TXT, и указывает на Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
ByVal TextColumns$, ByRef ErrorsArr) As Variant что теперь то не так может быть?

Ни разу не видел в VBA ошибки "значение вот этого кода неоднозначно"...
Покажите свой код полностью, или скриншот сообщения об ошибке.

PS: Код взят из рабочего файла - так что ошибок быть не должно.

макрос не запускается пишет значение вот этого кода неоднозначно: Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
ByVal TextColumns$, ByRef ErrorsArr) As Variant
что это может быть?

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
                                           _ 
__ _ _ __ __ _ ___ __ __ | |
/ _` | | '_ \ / _` | / __| \ \/ / _ | |
| (_| | | |_) | | (_| | \__ \ > < | |_| |
\__, | | .__/ \__, | |___/ /_/\_\ \___/
|___/ |_| |___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.