К примеру, есть у вас несколько десятков (или сотен) текстовых файлов с подобным содержимым:
(количество файлов, и количество строк данных в каждом файле не ограничено)
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 - приблизительно такого вида:
На помощь придёт функция 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
Комментарии
Последнюю строку в статье прочитайте
Надо скопировать в конец кода функцию из другой статьи
Не понимаю, что я делаю не так
Даже без исправлений выдает ошибку "sub or function not defined"
У кого заработало ?
У меня возникла проблема с
Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
ByVal TextColumns$, ByRef ErrorsArr) As Variant
Есть ли работающий вариант?
Найдите в коде строку
ro = tempArr(i): ro = Replace(ro, vbTab, ";")Запись ro = Replace(ro, vbTab, ";") заменяет разделитель табуляцию на точку с запятой
По аналогии, можно выполнить и другие замены? для других разделителей
Например, чтобы запятая тоже считалась разделителем, то дополните строку еще одной командой замены:
А можно указать несколько разделителей, если да, то как?
Цифра 7 в этой строке DataArr = DATfolder2Array(Папка, 7, "1,2,4,5", ErrorsArray) я так понимаю указывает на количество столбцов ?
Если до то как сделать без явного указания, чтобы определял из текстовика с разделением через ";" ?
Большое спасибо за Ваши разработки.
Здравствуйте, Иван.
В вашем случае нужен совсем другой, более сложный, макрос. Можем сделать под заказ.
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 строках надо поменять:
Добрый день, подскажите если не сложно.
В файлах данные разделяются при помощи - ","
Сложно переделать ваш код для того что бы он распознавал такое разделение?
Беру свои слова обратно, все работает
Пробовал запустить выполнение макроса на сбор данных из несколькоих 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
что это может быть?
Отправить комментарий