Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Как объединить несколько текстовых файлов в один?

Проблема сбора данных с текстовых файлов в один общий не такая распространенная, как сбор данных из нескольких файлов/листов в Excel, но все же она периодически возникает. Поэтому в этой статье просто делюсь решением, как это можно сделать при помощи не самого хитрого код. Все, что потребуется - это нажать кнопку и выбрать нужные файлы: текстовые или CSV. Далее небольшие настройки:
сначала появится запрос "Оставлять только один заголовок(первого файла)" - если указать ДА(YES), то в итоговом файле будет только один заголовок, из первого файла. Заголовки всех остальных файлов будут пропущены. Необходимо, когда в каждом из текстовых файлов есть заголовки и их включать в общий файл не требуется.
И если выбрано пропускать заголовки, то появится запрос - "Сколько строк в заголовке?". Нужно в случаях, если в текстовых файлов заголовки состоят более чем из одной строки(бывают и по 10 строк).

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
' Purpose: Процедура сбора данных с указанных текстовых файлов, оставляя только один заголовок
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub GetAllTxt_SkipHeader()
    Dim avFiles, li As Long, lHeadLinesCount As Long, lh As Long
    Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt
    Dim IsSkipHeader As Boolean
    Dim sToSavePath, sNewLine As String
    'диалог выбора текстовых файлов. Подробнее:
    '   https://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
    avFiles = Application.GetOpenFilename("TXT files(*.txt),*.txt,CSV files(*.csv),*.csv", , , , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
    'диалог выбора папки для сохранения файла. Подробнее:
    '   https://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/#saveas
    sToSavePath = Application.GetSaveAsFilename( _
             InitialFileName:=ThisWorkbook.Path, _
             FileFilter:="Text files(*.txt),*.txt", _
             FilterIndex:=1, _
             Title:="Сохранить файл как")
    'если нажали Отмена - завершаем процедуру ничего не сохраняя
    If VarType(sToSavePath) = vbBoolean Then
        Exit Sub
    End If
 
    IsSkipHeader = MsgBox("Пропускать заголовки в файлах, оставив только один (из первого файла)?" & vbNewLine & _
                          vbTab & "ДА  - в итоговый файл будет записан заголовок из первого файла. Заголовки остальных файлов будут пропущены." & vbNewLine & _
                          vbTab & "НЕТ - копируются все данные всех файлов, независимо от наличия или отсутствия в них заголовков", _
                          vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes
    If IsSkipHeader Then
        lHeadLinesCount = Val(InputBox("Сколько строк в заголовке?", "www.excel-vba.ru", 1))
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For li = LBound(avFiles) To UBound(avFiles)
        'открываем текстовый файл
        Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1)
        'если заголовок уже записан и указано оставлять только один заголовок
        'пропускаем строки заголовков для 2-го и последующих файлов
        If IsSkipHeader Then
            If li > LBound(avFiles) Then
                For lh = 1 To lHeadLinesCount
                    objTxtFile.skipline
                Next
            End If
        End If
        'считываем все данные файла
        sTxt = objTxtFile.ReadAll
        If sAllTxt = "" Then
            sAllTxt = sTxt
        Else
            sNewLine = vbNullString
            If Right(sAllTxt, 1) <> vbLf And Right(sAllTxt, 1) <> vbCr Then
                sNewLine = vbCr
            End If
            sAllTxt = sAllTxt & sNewLine & sTxt
        End If
        'закрываем текстовый файл
        objTxtFile.Close
    Next li
    'создаем новый файл и записываем в него все считанные с файлов данные
    Set objTxtFile = objFSO.CreateTextFile(sToSavePath, True)
    objTxtFile.WriteLine sAllTxt
    objTxtFile.Close
    Set objTxtFile = Nothing
    Set objFSO = Nothing
 
    MsgBox "Данные всех файлов собраны и сохранены в файл: '" & sToSavePath & "'", vbInformation, "www.excel-vba.ru"
End Sub

Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, из Excel переходим в редактор VBA(Alt+F11) -Insert -Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt+F8 -выделяем имя макроса -Выполнить(Run).
Так же можно создать кнопку на листе для вызова кода: Как создать кнопку для вызова макроса на листе?.
После работы кода в выбранной папке создан новый текстовый файл(с указанным во втором диалоговом окне именем), в котором и будут содержаться данные всех выбранных файлов.
Скачать пример

  Объединить все текстовые файлы.xls (60,0 КиБ, 5 969 скачиваний)

Так же см.:
Сбор данных с нескольких листов/книг
Как собрать данные с нескольких листов или книг?


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 31 комментарий
  1. babkakoshka:

    Спасибо большое. Поменяла в коде txt на csv - тоже обьединяет

  2. Александр:

    Дмитрий, отличный макрос! Но есть огромная проблема - создает дополнительные абзацы. Это неисправимо?

  3. Александр:

    А можно без диалогового окна? Как-то напрямую задать в макросе выбор всех файлов из папки?

  4. Бахтияр:

    Добрый день! Спасибо за код. У меня 2 вопроса:

    1) Подскажите пожалуйста почему при объединений файлов 1 строка и последняя строка выходят пустыми, как можно сделать что бы они не были пустыми?

    2) Как можно выбирать 2 txt файла из разных папок? На данный момент я могу выбирать только из одной папки 2 txt файла, когда выбираю первый и перехожу к другой папки, у меня выбирает только последний.

    Заранее спасибо за помощь.

  5. V:

    Спасибо большое.

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

    • Да, возможность есть. Но для этого надо создавать доп.массив и проверки, плюс учитывать какой символ/символы являются символами новой строки в файлах. Если будет возможность - дополню статью подобным кодом.

  6. Радик:

    Спасибо за код. Все работает. А что нужно дописать, чтобы в последнем столбце или первом вставлялось наименование файла?

  7. Елена:

    Подскажите как исправить код, чтобы объединенный файл сохранялся в книге макроса на определенном листе?

    • Елена, самое просто просто записать макрос открытия итогового текстового файла через стандартный диалог Excel с последующим сохранением.

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти