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

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

Функция предназначена для разбивки текстового файла на несколько файлов меньшего размера - в каждом из которых будет не более заданнного количества строк

Разделитель строк (обычно это перевод строки - константа vbNewLine) задаётся в качестве параметра функции Delimiter$

Создаваемые файлы получают имена вида 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

Комментарии

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

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

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

Понятно, спасибо!

Дмитрий, данный макрос не рассчитан на файлы размером 117мб
(он для маленьких файлов - до 1-10 Мб)
Для огромных файлов (как ваш) - совсем другие технологии обработки надо применять (построчное чтение),
чтобы быстрее всё работало, и памяти хватало на обработку.
Не пытайтесь найти такое у меня на сайте, - мои «универсальные» макросы не рассчитаны на файлы такого объема

Да, и если читать файл не ReadAll, а ReadLine, то строки корректно читаются при отладке. Но так как строк много, то в режиме отладки весь файл нет желания гонять, а как только работа начинается в обычном режиме, эксель виснет. Может это из-за большого числа строк?

Спасибо за ответ! Но не помогло. В окне отладчика вижу, что в txt появились символы ? вместо текста, а на строке txt = Split(txt, Delimiter$, 2)(1) вылетает ошибка subscript out of range. Насколько я понял - не видит разделителя и не может разбить строку на подстроки.

Здравствуйте, Дмитрий

в строке

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

добавьте еще один параметр True:
Set ts = fso.OpenTextFile(filename, 1, True, True): txt = ts.ReadAll: ts.Close

у вас файл в другой кодировке (unicode) - дополнительный параметр TRUE как раз для этого предназначен

Здравствуйте! Ваш код использую для обработки файлов. Но при обработке очередного файла в строке Set ts = fso.OpenTextFile(filename, 1, True): txt = ts.ReadAll: ts.Close не читается исходный файл. В txt передается "". Исходный файл csv. Подобных файлов (и по структуре и типу данных) обработано с десяток, было все отлично, а тут проблема. Не могу понять в чем причина. Может подскажете? Единственное отличие этот злополучный файл больше других - 117мб

Спасибо, попробую. Извините, что вопрос не по теме - не разобрался по порядку общения... Я тут в первый раз.

Марат, а какое отношение ваш вопрос имеет к теме статьи?
Задайте вопрос на форуме по Excel, - там подскажут.
Я бы использовал GetObject для получения доступа к файлу, если известен путь, по которому файл сохранён.

Здравствуйте Игорь, проблема такая - открыты два экселевских файла, но оба в своих родительских окнах, необходимо из одного файла перекинуть информацию в другой. Макрос, прикрепленный к одному из файлов, не видит книгу в другом родительском окне. Как его все-таки увидеть?

Галия, в данном случае в коде очень много чего менять надо.
Проще написать макрос «с нуля».

Оформляйте заказ на сайте (если готовы оплатить помощь),
или обратитесь на форумы по Excel (если хотите, чтобы вам помогли бесплатно)

Спасибо, очень помогли!
Подскажите, пожалуйста, еще немножко
Есть экселевский файл, в нем несколько столбцов. Необходимо, например, если значение в столбце А больше 0, записывать в первый файл, если больше 5, в следующий, т.е. кол-во строк в файлах мы сами не задаем, а определяем из условия. Как это реализовать? Как я понимаю, нужно поменять в этом месте
If rc>= MaxRowsCount& ...
На что-то в этом роде
If Cells(i, "A") >0 "0" Then ..
дальше вот как с файлами работать не знай

замените строку

ext$ = "." & Split(filename$, ".")(UBound(Split(filename$, ".")))

на строку
ext$ = ".xls"

Получатся текстовые файлы с расширением xls - Excel их поймёт.
чтобы XLSX получить, - это код заметно переделывать надо.

Здравствуйте! Скажите, пожалуйста, можно ли как-нибудь изменить макрос, чтоб новые файлы были с расширением .xlsx?

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

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

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

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