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

Макрос создания текстовых файлов по таблице Excel

Макрос предназначен для создания текстовых файлов в кодировке UTF-8.

Исходными данными является таблица Excel из 12 столбцов.

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

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

И потом, когда папка для файла создана, макрос создаёт текстовый файл с содержимым из 10 столбца таблицы,
и сохраняет его под именем, взятым из второго столбца той же таблицы Excel.
После создания файла, у него меняется кодировка на UTF-8 (изначально, при создании, файлы имеют кодировку Unicode)

По окончании работы макроса, открывается папка, содержащая созданные текстовые файлы.

Пример макроса смотрите в прикреплённом файле.


Код макроса, создающего папки, подпапки, и текстовые файлы по данным из таблицы Excel:

Sub СозданиеТекстовыхФайлов()
    On Error Resume Next
    Dim cell As Range, ra As Range
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
    arr = ra.Value    ' считываем данные в массив

    Set FSO = CreateObject("scripting.filesystemobject")
    ' создаём главную папку
    BaseFolder$ = ThisWorkbook.Path & "\Товар по группам\": MkDir BaseFolder$
 
    ' перебираем все строки
    For i = LBound(arr) To UBound(arr)
        ' создаём папку для очередной строки (если папки ещё нет)
        Folder$ = BaseFolder$ & arr(i, 7) & "\"    ' имя папки - в столбце G
        MkDir Folder$
 
        ' формируем имя создаваемого текстового файла
        Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"
 
        ' создаём файл в кодировке Unicode
        Set ts = FSO.CreateTextFile(Filename$, True, True)
        ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца
        ts.Close
 
        ' если текстовый файл нужен в другой кодировке
        ChangeFileCharset Filename$, "utf-8"
    Next i
 
    Set ts = Nothing: Set FSO = Nothing
    MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"
 
    ' открываем папку с файлами
    CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"
End Sub

ВложениеРазмерЗагрузкиПоследняя загрузка
prays.xls38.5 КБ1523 дня 22 часа назад

Комментарии

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

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

Здравствуйте, Наталья
Ограничений по текстовым файлам никаких нет
Если файл пустой, - скорее всего, макрос не все данные с листа собирает для вывода в файл.
Если сами не разберётесь, - могу написать макрос под заказ.

Здравствуйте пользуюсь вашим макросом, подскажите, существуют ли ограничения при формировании текстового файла? Столкнулась с тем что файл после формирования пуст или вставлена часть данных которые идут в начале, может ли это быть из-за того что в ячейках excel содержатся большие количества символов, около 240 в каждой и ячеек 26 шт? В чем еще может быть причина?

как сделать перенос строк, подскажите плиз

Здравствуйте, Никита.
Где почитать - не знаю (я в гугле обычно ищу, и читаю)
Можно поискать похожие макросы в инете, и доработать под свою задачу.
Можно заказать написание макроса, - сделаем под заказ.

Добрый день!
Подскажите пожалуйста, где почитать инфу для решения задачи:
Есть таблица Excel #1, количество строк около 2000 тысяч.
Нужно чтобы автоматически создавались отдельные файлы Excel по каждой строке из таблицы Excel #1.

Здравствуйте, Александр
Да, могу и такой макрос сделать, - оформляйте заказ через сайт с примером исходного файла и примером результата.

Здравствуйте, макрос очень полезен! Спасибо!

А не могли бы вы такой же макрос сделать, но только чтобы файлы создавались по столбцам, а имя бралось из первой строки. То есть все что написано в столбце А2:A100, попадало в файл с именем как в А1. И ещё бы хорошо было, чтобы макрос вставлял до первой пустой ячейки.

Наталья, можно сделать как угодно, - макросы могут всё)
Оформляйте заказ, - сделаем.

Подскажите, а мог бы макрос формировать файлы с данными не из одной строки Excel, а из нескольких опираясь на общий признак, например по группам? Например: есть группа чай и в нее входят поля из четырех строк Excel, нужно чтобы все они присутствовали в одном файле и над ними первой строкой была бы шапка "Шапка+название группы". Файл Excelя будет отсортирован по этому признаку, в нем не будет более 500 строк.
Пример:
"Шапка чай "
супер чай для всех
супер пупер чай для каждого
быстрый чай
не очень быстрый чай

возможно неверно выразился. я все экспериментировал с Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"
для того, чтобы из столбца и уникальной ячейки выходило с номером. Т.е. имея данные столбце: товар А, товар Б, товар В получать на выходе файлы типа: 1.товар А, 2.товар Б, 3.товар В
как такое провернуть?
буду благодарен за ответ)

Дмитрий, вместо строки

' формируем имя создаваемого текстового файла
        Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"

напишите
  ' формируем имя создаваемого текстового файла
 ind& = ind& + 1:    Filename$ = Folder$ & ind& & ".txt"

Подскажите, пожалуйста, как сделать так, чтобы файлы еще и нумеровались? ну или либо нумерацию из первого столбца брал.

Решено так:

Set ts = FSO.CreateTextFile(Filename$, True, True)
txt = Trim(arr(i, 10)) 'Данные в файл из ячейки 10-го столбца
txt = Replace(txt, vbNewLine, vbCrLf) ' заменяем Последовательность символов перехода на новую строку на Сочетание символов возврата каретки и перевода строки.
txt = Replace(txt, vbLf, vbCrLf) ' заменяем Символ перевода строки на Сочетание символов возврата каретки и перевода строки.
ts.Write txt ' Пишем текстовое значение в файл
ts.Close

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

для этого замените код

ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца

на что-то типа такого:
txt = Trim(arr(i, 10))    ' берем данные из ячейки 10-го столбца
txt = replace(txt, vbnewline, ";") ' заменяем перевод строки на ;
txt = replace(txt, vblf, ";") ' заменяем перевод строки на ;
ts.Write txt     ' пишем текстовое значение без переводов строки в файл

Огромное тебе спасибо мил человек! Все работает изюмительно!
Подскажи только, как сделать так, чтобы данные как многострочный текст сохранялись, ибо в ячейке текст многострочный http://joxi.ru/xAeGVebtY6MJVm. Иначе он их склеивает
http://joxi.ru/J2bej5bc4Yg83m
Заранее благодарю!

Вопрос снят. Справилась.

Спасибо за макрос! А если мне надо что бы
ts.Write Trim(arr(i, 10)) ' данные в файл - из ячейки 10-го столбца
несколько раз вставлялись в файл С НОВОЙ СТРОКИ, т.е. визуально располагаясь друг под другом?
Есть такая возможность?

Добрый день. Очень нужна помощь. У меня в Excel в качестве разделителя целой и дробной части стоит точка. Но когда я посредством макроса экспортирую данные в txt формат, точка становится запятой. Как это можно предотвратить?
Дописано: Я понимаю, что можно в блокноте заменить "." на ",", но у меня куча этих файлов, так что это не вариант. Надо как-то в макросе это изобразить.
Спасибо.

Здравствуйте, Михаил

В коде написано:

ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца

Соответственно, если в некоторых строках в 10-м столбце пусто - то и файл пустой будет создан

Добрый день,

спасибо за макрос, работает, создает файлы около 100 шт
но первые 10 корректные, а остальные пустые.
Можете подсказать как исправить?

ms office2010

Василий, если у вас мои макросы не работают, - это только потому, что вы их не можете правильно применить
У меня всё всегда работает на отлично)

Если даже для вас ценность этого макроса невелика, - то я, тем более, не вижу смысла тратить на него свое время.
Вы мне хотите сказать, что этот макрос нужнее мне, чем вам?))
PS: А трафика мне на сайте хватает)

1. я не то чтобы не могу в них разобраться, те макросы, что вы предложили попросту не работают у меня, ни один, ни второй. Что получилось у меня после их применения я выложил на Яндекс.Диск - это даже не критика, а просто так скажем "сообщение об ошибке администратору"

2. задача, с которой я к вам обратился относится к категории "удобная добавка", то есть то же самое делается вручную за 15 секунд, то есть ценность её, скажем так, невелика. Просто реализовав её вы могли бы привлечь дополнительный трафик к себе на сайт, то есть выгода для вас тоже имеется. А вот платить за неё я не вижу никакого смысла - и так, честно говоря, жаль времени, потраченного на поиски её решения

Здравствуйте, Василий

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

мой предыдущий ответ видимо оказался слишком мудрёным :) а жаль...

спасибо за желание помочь, но боюсь, что это что-то не то
если я правильно всё понимаю, то приведённый вами код состоит из 2 частей:

1. макрос, который если его запустить в открытом в Excel файле .csv перекодирует данный файл в utf-8 без BOM. Не знаю почему, но у меня он не работает.

Делаю ровно следующее - есть простенькая таблица в Excel, сохраняю её как .csv, запускаю макрос, файл закрывается. Если его после этого открывать хоть Excel хоть Notepad++, то там абракадабра в одну строчку, при этом Notepad++ как показывал в оригинальном файле кодировку ANSI, так и показывает его в новом файле.

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

во-первых, непонятно что указывать в аргументе SourceCharset
во-вторых, если SourceCharset не указыавать, то получается абракадабра в одну строчку как в случае выше, хотя тут уж Notepad++ соглашается, что кодировка стала utf-8 без BOM
в-третьих, изначальная задача звучала совсем по-другому, а именно

"есть табличка Excel в формате, допустим .xlsx. При нажатии на макрос, он сохраняет данную табличку в той же папке, но в формате .csv, причём .csv этот в кодировке utf-8 без BOM" (собственно, возможность указать кодировку при сохранении .csv есть в OpenOffice Calc, но любимый Excel почему-то не может себе это позволить...)

когда я искал, как это можно реализовать, все отвечавшие либо предлагали делать это вручную, либо давали ссылку на вашу статью http://excelvba.ru/code/Encode но эта статья не содержит в себе решения на задачу выше, она только позволяет перекодировать уже готовый .csv - в принципе получается всё тот же ручной способ

в общем, думаю, если получится реализовать вариант как в OpenOffice Calc или вариант проще, то есть без выбора папки для сохранения (можно отдельную статью этому посвятить, кстати), то приток дополнительных посетителей из нуждающихся вебмастеров к вам на сайт обеспечен. А сайт, кстати, очень крутой, прям не верится, что он российского происхождения...

дабы не быть голословным по поводу не рабочести макросов прилагаю все использованные и получившиеся материалы http://yadi.sk/d/Svq04uDVPXHdv

Здравствуйте, Василий.
Макрос и кнопка при всём желании в CSV не сохранятся, - CSV это текстовый формат.

Макрос можно упростить, - если сохранять весь файл в CSV
Если вы вручную сохранили файл в формате CSV, - в макросе достаточно будет 3 строк:
(сам макрос можно сохранить в личной книге макросов, и запускать по нажатию горячей клавиши)

sub Перекодировка()
  filename$ = ActiveWorkbook.Fullname ' запоминаем имя открытого файла CSV 
  ActiveWorkbook.close false ' закрываем файл без сохранения изменений
  ChangeFileCharset_UTF8noBOM Filename$ ' перекодировка файла
end sub
 
Function ChangeFileCharset_UTF8noBOM(ByVal filename$, Optional ByVal SourceCharset$) As Boolean
    ' функция перекодировки (смены кодировки) текстового файла
   ' В качестве параметров функция получает путь filename$ к текстовому файлу,
   ' Функция возвращает TRUE, если перекодировка прошла успешно
   On Error Resume Next: Err.Clear
    DestCharset$ = "utf-8"
    With CreateObject("ADODB.Stream")
        .Type = 2
        If Len(SourceCharset$) Then .Charset = SourceCharset$        ' указываем исходную кодировку
       .Open
        .LoadFromFile filename$        ' загружаем данные из файла
       FileContent$ = .ReadText        ' считываем текст файла в переменную FileContent$
       .Close
        .Charset = DestCharset$        ' назначаем новую кодировку "utf-8"
       .Open
        .WriteText FileContent$
 
        'Write your data into the stream.

        Dim binaryStream As Object
        Set binaryStream = CreateObject("ADODB.Stream")
        binaryStream.Type = 1
        binaryStream.Mode = 3
        binaryStream.Open
        'Skip BOM bytes
       .Position = 3
        .CopyTo binaryStream
        .Flush
        .Close
        binaryStream.SaveToFile filename$, 2
        binaryStream.Close
    End With
    ChangeFileCharset_UTF8noBOM = Err = 0
End Function

Здравствуйте! Чувствую, что в этом макросе есть всё что нужно для моей задачи, но как его вычленить знаний не хватает.

А требуется очень простое, но с другой стороны очень нужное для вебмастеров действие (в инете обыскался - куча вопрошающих, ноль отвечающих): сохранить текущий .xls в .csv в кодировке "utf-8 без ВОМ", а нужно это для импорта на сайт данных из excel.

Каждый раз менять кодировку csv в блокноте утомительно, а так будет быстрее (а я правильно понимаю, что макрос и кнопка его запуска сами удалятся из csv?)

Удалось сделать то, что мне нужно благодаря этому вашему макросу http://excelvba.ru/code/ExtendArray Объединил оба проекта, получил пусть неоптимизированный, зато рабочий макрос :) Результат здесь: http://zalil.ru/34769096 Спасибо за ваши работы, очень выручили :)

Уважаемый администратор! Спасибо за помощь, только это не совсем то, что мне нужно :) Мне нужно писать данные из первого столбца не в название файла, а в сам файл. Допустим у меня в первом столбце имеются строки: 34,35,36. В во втором столбце соответственно строки 11, 12, 12. На выходе я хотел бы получить соответственно 2 файла txt: Первый будет называться "11" и в нем будут данные: "34", а второй будет называться "12" и в нем будут данные: "35/36". Заранее спасибо за помощь! :)

Замените в коде эту строку

       ' формируем имя создаваемого текстового файла
       Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"

на следующую:
      Filename$ = Folder$ & arr(i, 2) & "-" & arr(i, 1) & ".txt"

PS: знак "/" нельзя использовать в имени файла, - потому разделителем поставил символ "-"

Немного модифицировал ваш макрос под себя, но кое-что не могу сделать. У меня имеется 2 столбца с числами. Мне нужно формировать текстовые файлы с названиями из 2 столбца, в них писать данные из первого столбца. Это делается хорошо. Но если во 2 столбце число совпадает с предыдущем, то создается файл с таким же названием и он перезаписывает прошлый файл. А мне нужно чтобы туда дописывалось число из первого столбца через знак "/". Например 123456/789012. Как это сделать?

Такому не учат нигде - можно только самому научиться, если есть интерес к программированию.

Супер!!! Это просто праздник какой-то! Где этому учат? Всё работает как нужно.

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

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

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

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