Макрос excel как разбить большой текстовый файл
Перейти к содержимому

Макрос excel как разбить большой текстовый файл

Разбиение текстового файла (в т.ч. CSV) на несколько файлов с заданным количеством строк

Создаваемые файлы получают имена вида filename(1).txt, filename(2).txt и т.д.

Если задан параметр функции DeleteSourceFile равным TRUE, — то исходный файл удаляется после разделения

Функция возвращает коллекцию, содержащую пути к сформированным файлам

В начало каждого создаваемого файла дописывается строка заголовка — первая строка из исходного файла

Пример использования функции SplitTextFile:

Sub ПримерИспользованияФункции_SplitTextFile() ИмяРазбиваемогоФайла$ = "C:\test\2011 04 17 12-32-30.csv" МаксимальноеКоличествоСтрокВфайле& = 3 Dim СписокИмёнФайлов As Collection Set СписокИмёнФайлов = SplitTextFile(ИмяРазбиваемогоФайла$, МаксимальноеКоличествоСтрокВфайле&, vbNewLine, False) For Each Файл In СписокИмёнФайлов Debug.Print "Создан файл: " & Файл Next End Sub

Результат работы примера (из окна Immediate редактора VBA)

Создан файл: C:\test\2011 04 17 12-32-30(1).csv
Создан файл: C:\test\2011 04 17 12-32-30(2).csv
Создан файл: C:\test\2011 04 17 12-32-30(3).csv

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

Function SplitTextFile(ByVal filename$, ByVal MaxRowsCount&, ByVal Delimiter$, _ Optional ByVal DeleteSourceFile As Boolean = True) As Collection ' функция предназначена для разбивки текстового файла filename$ на несколько файлов ' меньшего размера - в каждом из которых будет не более MaxRowsCount& строк ' Разделение строк выполняется с использованием разделителя Delimiter$ ' Создаваемые файлы получают имена вида filename(1).txt, filename(2).txt и т.д. ' Если DeleteSourceFile = TRUE, - то исходный файл удаляется после разбивки ' Возвращает коллекцию имён созданных файлов ext$ = "." & Split(filename$, ".")(UBound(Split(filename$, "."))) Set fso = CreateObject("scripting.filesystemobject") Set ts = fso.OpenTextFile(filename, 1, True): txt = ts.ReadAll: ts.Close HeaderRow$ = Split(txt, Delimiter$, 2)(0) & Delimiter$ ' берем первую строку из файла как заголовок txt = Split(txt, Delimiter$, 2)(1) ' остаток текста - без строки заголовка ' удаляем разделители строк в конце текстовой строки (если таковые присутствуют) While txt Like "*" & Delimiter$: txt = Left(txt, Len(txt) - Len(Delimiter$)): Wend ' RowsCount = UBound(Split(txt, Delimiter$)) + 1 ' количество текстовых строк в файле FileIndex& = 1 ' индекс очередного создаваемого файла arr = Split(txt, Delimiter$): rc = 0: Set SplitTextFile = New Collection For i = LBound(arr) To UBound(arr) rc = rc + 1 NewTXT$ = NewTXT$ & arr(i) & Delimiter$ If rc >= MaxRowsCount& Or i = UBound(arr) Then ' набрали достаточно строк для записи в файл NewFilename$ = Mid(filename$, 1, Len(filename$) - Len(ext$)) & "(" & FileIndex & ")" & ext$ Set ts = fso.CreateTextFile(NewFilename$, True) ts.Write HeaderRow$ & NewTXT$: ts.Close SplitTextFile.Add NewFilename$ FileIndex& = FileIndex& + 1 rc = 0: NewTXT$ = "" End If Next i Set ts = Nothing: Set fso = Nothing If DeleteSourceFile Then Kill filename$ ' удаляем исходный файл, если DeleteSourceFile = TRUE End Function
  • 35059 просмотров

Комментарии

sadykovs, 12 Июн 2015 — 18:54. #1

Не удержался напишу) На ваш комментарий Дмитрию на счет больших файлов — больше всего понравилась софтина ASAP Utilities, функционал очень богатый, а для разбиения на файлы по строкам Sheets » Split the selected range into multiple worksheets..к вам забрел с тем же вопросом, пока в данной надстройке не нашел

Макрос excel как разбить большой текстовый файл

Argument ‘Topic id’ is null or empty

Сейчас на форуме

© Николай Павлов, Planetaexcel, 2006-2023
info@planetaexcel.ru

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

ООО «Планета Эксел»
ИНН 7735603520
ОГРН 1147746834949
ИП Павлов Николай Владимирович
ИНН 633015842586
ОГРНИП 310633031600071

Макрос excel как разбить большой текстовый файл

Hugo121, доигрался?
тобою уже пользователей пугают.

strannick, очень правильный ход — если задача не очень интересная, а ответ получить надо (обратите внимание, кто ответил первым)))), правда есть одна ошибка. Hugo121, он еще и в словарь может, причем ему удавалась загнать в словари такие слова. котырые до этого ни в одном словаре не встречались (Даль и Ожегов — отдыхают)

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Регистрация: 11.05.2010
Сообщений: 5,166

У меня тоже отработало.
Я говорил немного о другом — если сразу весь текст прочитать в переменную, затем бить в массив — то это нужно 2*14м строк (т.е. держать весь файл 2 раза в памяти). Затем переменную можно убить, и частями перекладывать из большого массива в миллионные — т.е. 14м+1м.
Если же объявлять по миллиону, заполнять из файла, выгружать и снова — то максимум миллион и одна текущая строка (ну или что там из файла будет в памяти) — что намного меньше.
Ну и сам заполняемый файл Экселя тоже где-то как-то должен жить.

webmoney: E265281470651 Z422237915069 R418926282008
Форумчанин
Регистрация: 21.10.2011
Сообщений: 433
Сообщение от Скрипт
У меня мало оперативной памяти на компьютере (2 Гб), но этот код выполнился

у меня подвисло(((

IgorGO насчет словарей — это я забыл))) было дело и неоднократно. Кстати, мой исходный файл — это словарь (английские слова и буквосочетания). Вот такой каламбурчик.

Hugo121 Видел на планете по такой почти теме вариант через массив, но не въехал. А вот «построчно» упоминание тоже встречалось, но примера так и не нашел. В загашниках не найдется?

Регистрация: 02.05.2009
Сообщений: 3,907

В загашниках не найдется?

В загашнике есть Скальпель,самописный
Текстовый файл чуть больше 16 млн.строк.
Строка длинной 60 символов.
Файл 998 метров.
Скальпель режет на файлы по 1 млн. строк со скоростью 1 файл -3 секунды.
Памяти берет 30 метров.

Анализ,обработка данных Недорого
Последний раз редактировалось doober; 28.05.2013 в 00:36 .
Регистрация: 11.05.2010
Сообщений: 5,166

По задаче словарь не нужен — с ним возни больше. Набрать в словарь легко, выгрузить сложнее.
Вот нашёл пример чтения построчно — там правда ещё и словарь, и разбивка строк в массив — на это не смотрите

Const ForReading = 1 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile _ ("c:\temp\Test.txt", ForReading) With CreateObject("Scripting.Dictionary") .CompareMode = 1 Do Until objTextFile.AtEndOfStream strNextLine = objTextFile.Readline arr = Split(strNextLine) For i = 0 to Ubound(arr) .item(arr(i))=0& Next Loop msgbox .count end with

webmoney: E265281470651 Z422237915069 R418926282008
Форумчанин
Регистрация: 24.12.2012
Сообщений: 906

Hugo121: Вот нашёл пример чтения построчно

я что-то не понял сложность задачи. Почему вы что-то искали, а не просто написали код по взятию данных из текстового файла в VBA-массив? В чём сложность?

strannick, в двух процедурах в константах нужно указать пути и имена текстовых файлов.

Sub Main() '1. Помещаем в константу "mySource" путь и имя текстового файла, 'из которого нужно взять данные. Const mySource As String = "C:\Users\User\Desktop\Новый текстовый документ.txt" '2. Помещаем в константу число, которое 'означает, сколько строк будет в массиве. Const mySize As Long = 1000000 Dim myArray() As Variant Dim myLineIndex As Long Dim myFileIndex As Long '3. Подготавливаем массив "myArray" к использованию. ReDim myArray(1 To mySize) '4. Открываем текстовый файл. '"For Input" переводится "для ввода", а нам нужно открыть 'для чтения. На самом деле всё правильно, просто 'это какая-то нестыковка в терминах. '1 - это имя в виде числа, которое даётся файлу. 'С помощью этого имени можно обращаться к файлу. Open mySource For Input As 1 '5. Двигаемся от строки к строке по текстовому файлу. 'Явно команды нет для перехода с одной строки на другую. 'Переход к следующей строке происходит после 'команды "Line Input". 'Двигаемся от строки к строке, пока не достигнем конца файла. Do While EOF(1) = False 'Сразу создать массив с нужным количеством 'строк мы не всегда сможем, т.к. может не хватить 'оперативной памяти. Поэтому будем периодически 'очищать массив. '6. С помощью переменной "myLineIndex" будем подсчитывать, 'сколько строк текстового файла мы уже взяли в массив. myLineIndex = myLineIndex + 1 'Если в массиве уже нужное количество строк. If myLineIndex > mySize Then '7. Формируем фрагмент имени текстового файла, в который 'перенесём данные. myFileIndex = myFileIndex + 1 '8. Переносим данные из массива куда-нибудь, 'например в другой текстовый файл. Call Procedure_1(myArray(), myLineIndex - 1, myFileIndex) '9. Очищаем массив. ReDim myArray(1 To mySize) '10. Подготавливаем переменную "myLineIndex". myLineIndex = 1 End If '11. Берём данные из текущей строки текстового файла 'и помещаем в массив. Line Input #1, myArray(myLineIndex) Loop '12. Переносим остатки в текстовый файл. myFileIndex = myFileIndex + 1 Call Procedure_1(myArray, myLineIndex, myFileIndex) '13. Закрываем текстовый файл. Close 1 End Sub Sub Procedure_1(myArray() As Variant, myLineIndex As Long, myFileIndex As Long) 'Перенос данных из массива в текстовый файл. '1. Помещаем в константу имя папки, где будут находиться 'текстовые файлы и первый фрагмент имени файла. Const myFolder As String = "C:\Users\User\Desktop\Новая папка\Файл_" Dim i As Long '2. Создаём и одновременно открываем текстовый файл. 'Здесь также перевод слова "Output" (вывод) не совпадает 'с тем, для чего мы открыли текстовый файл. Мы его 'открыли для ввода. Open myFolder & myFileIndex & ".txt" For Output As 2 '7. Переносим данные из массива в текстовый файл. For i = 1 To myLineIndex Step 1 Print #2, myArray(i) Next i '8. Закрываем текстовый файл. Close 2 End Sub
  1. Про работу с текстовыми файлами можно почитать на русском языке в самоучителях. Часто в VBA-самоучителях есть специально глава для работы с текстовыми файлами.
  2. Данный код предназначен для работы с текстовыми файлами с кодировкой «ANSI». Если предполагается работать с текстовыми файлами с кодировкой «Unicode», то нужно внести изменения в код или вообще отказаться от использования «Open» и использовать что-нибудь другое, например, объект «File System Object», или VBA-инструменты для работы с файлами, которые есть в самих программах «MS Office».

Последний раз редактировалось Скрипт; 28.05.2013 в 08:31 .

Как разделить .xlsx по строкам?

Есть большой файл больше 27 000 строк. Как его разделить на такие же .xlsx файлы, но скажем по 1000 строк?

  • Вопрос задан более трёх лет назад
  • 24613 просмотров

Комментировать
Решения вопроса 0
Ответы на вопрос 3

honor8

Принципы быстродействия VBA в описании

Если файл сохранён на диске, можно так:
1. Открываете книгу с данными на нужном листе
2. Заходите в VBA (Alt+F11)
3. Выбираете в меню Insert -> Module
4. Вставляете нижеприведённый код
5. Нажимаете F5 (не сохраняете исходный файл)

Option Explicit ' Обязательное объявление переменных Option Base 1 ' Нижняя граница массива (по умолчанию) '123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789 Sub Border_Limit() Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean Count = 1: Limit = 1000 ' Счётчик файлов; Количество строк SetTitle = False ' Если есть заголовок, заменить False на True SaveDir = ThisWorkbook.Path ' Или вписать полный путь для сохранения "C:\" ' Предполагается, что в колонке A нет пустых ячеек While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1)) Rows("1:" & Limit).Copy Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом ActiveSheet.Paste: Cells(1, 1).Select ActiveWorkbook.SaveAs Filename:=SaveDir & "\Массив_" & Count & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook ActiveWindow.Close Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp Count = Count + 1 Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). " End Sub

Никакие C++ запускать не надо.

Для пытливых умов: Отказ от Слияния в пользу шаблонов https://toster.ru/q/320942

Ответ написан более трёх лет назад
Нравится 7 5 комментариев

Как сохранить ширину строк исходной таблицы? Также как сохранить заголовок во всех файлах? При выборе «2» заголовок не сохраняется.
Заранее спасибо

honor8

kolyayolo, благодарю за замечание (обновил код), и хороший вопрос.
Для переноса ширины колонок нужно после объявления переменных сохранить значения ширины колонок в массив:

ReDim colWidth(Cells.SpecialCells(xlLastCell).Column) For Count = 1 To UBound(colWidth) ' Читаем ширину колонок colWidth(Count) = Cells(1, Count).ColumnWidth Next Count

Затем, после вставки данных перенести значения ширины колонок из массива:

' Пишем ширину колонок Cells(1, 1).Resize(1, UBound(colWidth)).ColumnWidth = colWidth

alcompstudio @alcompstudio

Спасибо за решение, искал везде, ваш подошел идеально! Единственный вопрос — а как сделать, чтобы полученные таблицы-файлы были «упакованы» в умные таблицы на выходе? Я не силен в VBA, подскажете какой код и куда его вписать?

alcompstudio @alcompstudio

Добавил код, который добавляет умную таблицу к диапазону, но есть проблема. У меня файлы формируются из заранее подготовленной умной таблицы, т.е. она разбивается на части. И этот (ваш) код получается формирует файлы с не отформатированными диапазонами, а последний файл именно форматируется в умную таблицу (как бы унаследует формат из исходного файла). Т.е. не все сформированные файлы с умными таблицами получаются, а только последний. А мне нужно, чтобы все были оформлены в умные таблицы. Я добавил код, который добавляет формат в полученные файлы, вот такое у меня получилось:

Option Explicit ' Обязательное объявление переменных Option Base 1 ' Нижняя граница массива (по умолчанию) '12345678901234567890123456789012345bopoh13@ya67890123456789012345678toster56789 Sub Border_Limit() Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean Count = 1: Limit = 2001 ' Счётчик файлов; Количество строк SetTitle = True ' Если есть заголовок, заменить False на True SaveDir = "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" ' Или вписать полный путь для сохранения "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" или ThisWorkbook.Path ' Предполагается, что в колонке A нет пустых ячеек While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1)) Rows("1:" & Limit).Copy Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом ActiveSheet.Paste: Cells(1, 1).Select '-------Оформляем полученные таблицы в умные---------- Dim a As Long 'Определяем количество строк a = Cells(1, 1).CurrentRegion.Rows.Count 'Создаем «умную» таблицу с сохранением первой строки заголовков ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(a, 17)), , xlYes).Name _ = "TableRange" ActiveWorkbook.SaveAs Filename:=SaveDir & "\BOM_test_" & Count & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook ActiveWindow.Close Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp Count = Count + 1 Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). " End Sub

Но в результате получается ошибка, т.к. система пытается последнюю таблицу, которая «умная» тоже повторно оформить.
Подскажете, как подправить?

honor8

kolyayolo, alcompstudio, на технических ресурсах принято выражать свою положительную оценку кнопкой «Нравится«, тем самым указывая на полезность материала.

Для создания умной таблицы для всего активного листа с именем «Table_1» используется следующий метод (четвёртый параметр указывает на наличие заголовков):

ActiveSheet.ListObjects.Add(, ActiveSheet.UsedRange, , xlYes).Name = "Table_1"

Для удаления единственной умной таблицы на активном листе используется метод:
ActiveSheet.ListObjects(1).Delete

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *