Главная » Макросы для Excel » Макрос создания текстовых файлов по таблице 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 КБ
  • 70079 просмотров

Комментарии

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

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".
Константин, 6 Июл 2023 - 16:31.#1

Подскажите пожалуйста при запуске создается только один документ вместо 50. хотя все 50 строк и столбцы как в инструкции заполнены. Спасибо.

Игорь (администратор сайта), 16 Фев 2018 - 18:25.#2

Сделайте проще:

 ts.Write arr(i, 1) & vbTab & arr(i, 2) & vbTab & arr(i, 3) & vbTab & arr(i, 4)

Гость, 16 Фев 2018 - 15:22.#3

Спасибо автору за идею макроса. Вы не могли бы подсказать, а можно ли его усложнить, чтобы перенести все строки таблицы Эксель в виде колонок в текстовые файлы. (те чтобы каждая строка Эксель файла переносилась бы в виде столбца в новый текстовый файл) Полагаю, что править нужно следующую часть макроса ts.Write Trim(arr(i, 10)) путем использования Application.Transpose применительно к строке, мучаюсь никак не могу правильно построить команду.

Игорь (администратор сайта), 27 Янв 2017 - 03:31.#4

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

Наталья, 27 Янв 2017 - 02:37.#5

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

Гость, 12 Янв 2017 - 17:41.#6

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

Игорь (администратор сайта), 14 Апр 2016 - 14:34.#7

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

Гость -Никита, 14 Апр 2016 - 14:12.#8

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

Игорь (администратор сайта), 13 Апр 2016 - 14:01.#9

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

Александр, 13 Апр 2016 - 13:57.#10

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

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

Игорь (администратор сайта), 9 Мар 2016 - 08:34.#11

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

Наталья, 9 Мар 2016 - 03:54.#12

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

Дмитрий, 1 Мар 2016 - 00:10.#13

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

Игорь (администратор сайта), 29 Фев 2016 - 23:54.#14

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

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

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

Дмитрий, 29 Фев 2016 - 22:01.#15

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

Григорий, 11 Фев 2016 - 14:26.#16

Решено так:

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

Игорь (администратор сайта), 11 Фев 2016 - 04:36.#17

Текстовый формат таблицы (он же 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     ' пишем текстовое значение без переводов строки в файл

Григорий, 11 Фев 2016 - 00:11.#18

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

Наталья, 10 Фев 2016 - 13:22.#19

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

Наталья, 10 Фев 2016 - 12:47.#20

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

Гость, 20 Ноя 2014 - 14:12.#21

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

Игорь (администратор сайта), 12 Окт 2014 - 00:10.#22

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

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

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

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

Михаил, 12 Окт 2014 - 00:07.#23

Добрый день,

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

ms office2010

Игорь (администратор сайта), 18 Май 2014 - 20:25.#24

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

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

Василий, 18 Май 2014 - 20:17.#25

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

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

Игорь (администратор сайта), 18 Май 2014 - 19:10.#26

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

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

Василий, 18 Май 2014 - 19:04.#27

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

Василий, 8 Май 2014 - 22:01.#28

спасибо за желание помочь, но боюсь, что это что-то не то
если я правильно всё понимаю, то приведённый вами код состоит из 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

Игорь (администратор сайта), 1 Май 2014 - 01:53.#29

Здравствуйте, Василий.
Макрос и кнопка при всём желании в 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

Василий, 30 Апр 2014 - 17:41.#30

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

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

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

Гость, 10 Окт 2013 - 21:17.#31

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

Гость, 10 Окт 2013 - 18:06.#32

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

Игорь (администратор сайта), 10 Окт 2013 - 16:41.#33

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

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

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

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

Гость, 10 Окт 2013 - 15:57.#34

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

Игорь (администратор сайта), 27 Авг 2012 - 01:49.#35

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

Андрей, 26 Авг 2012 - 22:44.#36

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

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

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

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

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