Note: The other languages of the website are Google-translated. Back to English

Как импортировать несколько текстовых файлов из папки на один лист?

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

Импортируйте несколько текстовых файлов из одной папки на один лист с помощью VBA

Импортируйте текстовый файл в активную ячейку с помощью Kutools for Excel хорошая идея3


Вот код VBA, который поможет вам импортировать все текстовые файлы из одной конкретной папки на новый лист.

1. Включите книгу, в которую хотите импортировать текстовые файлы, и нажмите Alt + F11 ключи для включения Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модули, скопируйте и вставьте ниже код VBA в Модули окно.

VBA: импорт нескольких текстовых файлов из одной папки на один лист

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3. Нажмите F5 для отображения диалогового окна и выберите папку, содержащую текстовые файлы, которые вы хотите импортировать. Смотрите скриншот:
doc импортировать текстовые файлы из папки 1

4. Нажмите OK. Затем текстовые файлы были импортированы в активную книгу как новый лист отдельно.
doc импортировать текстовые файлы из папки 2


Если вы хотите импортировать один текстовый файл в определенную ячейку или диапазон, вы можете применить Kutools for ExcelАвтора Вставить файл в курсор утилита.

Kutools for Excel, с более чем 300 удобные функции, облегчающие вашу работу. 

После бесплатная установка Kutools for Excel, сделайте следующее:

1. Выберите ячейку, в которую хотите импортировать текстовый файл, и нажмите Кутулс Плюс > Импорт Экспорт > Вставить файл в курсор. Смотрите скриншот:
doc импортировать текстовые файлы из папки 3

2. Затем появится диалоговое окно, нажмите Приложения для отображения Выберите файл для вставки в диалог положения курсора ячейки, затем выберите Текстовые файлы из раскрывающегося списка, а затем выберите текстовый файл, который вы хотите импортировать. Смотрите скриншот:
doc импортировать текстовые файлы из папки 4

3. Нажмите Откройте > Ok, и указанный текстовый файл был вставлен в позицию курсора, см. снимок экрана:
doc импортировать текстовые файлы из папки 5


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (46)
Номинальный 4 из 5 · рейтинги 1
Этот комментарий был сведен к минимуму модератором на сайте
Sub Test ()
'ОбновитьExtendoffice6/7/2016
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Дим я пока
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Если xFile="" Тогда
MsgBox «Файлы не найдены», vbInformation, «Kutools для Excel»
Exit Sub
End If
Делать, пока xFile <> ""
xFiles.Добавить xFile, xFile
xФайл = Каталог()
Петля
Установите xToBook = ThisWorkbook
Если xFiles.Count > 0 Тогда
Для I = 1 To xFiles.Count
Установить xWb = Workbooks.Open(xStrPath и xFiles.Item(I))
xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
По ошибке GoTo 0
xWb.Close Ложь
Далее
End If
End Sub

этот код помогает, но я хочу

табуляция, точка с запятой, пробел, как это сделать, пожалуйста, помогите мне
Этот комментарий был сведен к минимуму модератором на сайте
Вы хотите сохранить пробел (разделители) после преобразования текстовых файлов в листы?
Этот комментарий был сведен к минимуму модератором на сайте
это тоже моя проблема, этот код верен. но после преобразования текстовых файлов в excel он не сохраняет разделители.
Этот комментарий был сведен к минимуму модератором на сайте
Не могли бы вы загрузить текстовый файл и результат, который вы хотите для меня?
Этот комментарий был сведен к минимуму модератором на сайте
У меня точно такая же проблема. Все текстовые файлы находятся на отдельных листах, и код игнорирует пространство между двумя столбцами.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Дес и П. Б. Рама Мурти, приведенный ниже код может разбивать данные на столбцы на основе пробела или табуляции при импорте текстового файла на листы. Вы можете попробовать.

Подпрограмма ImportTextToExcel()
'ОбновитьExtendoffice20180911
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Дим я пока
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue как строка
Dim xRg как диапазон
Тусклый xArr
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Если xFile="" Тогда
MsgBox «Файлы не найдены», vbInformation, «Kutools для Excel»
Exit Sub
End If
Делать, пока xFile <> ""
xFiles.Добавить xFile, xFile
xФайл = Каталог()
Петля
Установите xToBook = ThisWorkbook
On Error Resume Next
Приложение.ScreenUpdating = False
Если xFiles.Count > 0 Тогда

Для I = 1 To xFiles.Count
Установить xWb = Workbooks.Open(xStrPath и xFiles.Item(I))
xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close Ложь
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Для xFNum = 1 Для xIntRow
Установите xRg = ActiveSheet.Range("A" & xFNum)
xArr = Разделить (xRg.Text, "")
Если UBound(xArr) > 0 Тогда
Для xFArr = 0 в UBound(xArr)
Если xArr(xFArr) <> "" Тогда
xRg.Value = xArr(xFArr)
Установите xRg = xRg.Offset (Смещение столбца: = 1)
End If
Далее
End If
Далее
Далее
End If
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Какие изменения необходимы, если вы хотите разделить данные на столбцы на основе запятой
Этот комментарий был сведен к минимуму модератором на сайте
Какие изменения нужно сделать, если мне нужно разбить данные на столбцы через запятую?
Этот комментарий был сведен к минимуму модератором на сайте
Я использовал это, и это работает, но я хотел бы, чтобы все это сохранялось на одном листе, поскольку каждый лист содержит одну и ту же информацию, это просто файлы журналов за каждый день.
поэтому мне нужно объединить
все элементы в папке на один лист
Sub ImportCSVsWithReference()
«Обновление от Kutools forExcel20151214
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Дим я пока
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue как строка
Dim xRg как диапазон
Тусклый xArr
При ошибке Перейти к ErrHandler
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
Установите xSht = ThisWorkbook.ActiveSheet
Если MsgBox("Очистить существующий лист перед импортом?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Приложение.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
Делать, пока xFile <> ""
Установите xWb = Workbooks.Open (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close Ложь
xФайл = Каталог
Петля
Application.ScreenUpdating = True
Exit Sub
Обработчик ошибок:
MsgBox «нет файлов txt», «Kutools for Excel»
End Sub

и этот, который использует пробелы для добавления в каждый столбец

Подпрограмма ImportTextToExcel()
'ОбновитьExtendoffice20180911
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Дим я пока
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue как строка
Dim xRg как диапазон
Тусклый xArr
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Если xFile="" Тогда
MsgBox «Файлы не найдены», vbInformation, «Kutools для Excel»
Exit Sub
End If
Делать, пока xFile <> ""
xFiles.Добавить xFile, xFile
xФайл = Каталог()
Петля
Установите xToBook = ThisWorkbook
On Error Resume Next
Приложение.ScreenUpdating = False
Если xFiles.Count > 0 Тогда

Для I = 1 To xFiles.Count
Установить xWb = Workbooks.Open(xStrPath и xFiles.Item(I))
xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close Ложь
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Для xFNum = 1 Для xIntRow
Установите xRg = ActiveSheet.Range("A" & xFNum)
xArr = Разделить (xRg.Text, "")
Если UBound(xArr) > 0 Тогда
Для xFArr = 0 в UBound(xArr)
Если xArr(xFArr) <> "" Тогда
xRg.Value = xArr(xFArr)
Установите xRg = xRg.Offset (Смещение столбца: = 1)
End If
Далее
End If
Далее
Далее
End If
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
как сделать, если мой файл Txt содержит разделители с запятой?
Этот комментарий был сведен к минимуму модератором на сайте
Вы можете использовать функцию «Найти и заменить», чтобы сначала заменить запятую пробелом, а затем применить один из вышеуказанных методов, чтобы преобразовать его в файл Excel.
Этот комментарий был сведен к минимуму модератором на сайте
Нет ли способа изменить это в коде? Мне пришлось бы сделать это со 130 файлами
Этот комментарий был сведен к минимуму модератором на сайте
Тот же вопрос
Этот комментарий был сведен к минимуму модератором на сайте
Для тех, кому все еще нужна помощь, замените xArr = Split(xRg.Text, " ") на xArr = Split(xRg.Text, ",").
Этот комментарий был сведен к минимуму модератором на сайте
Когда я запускаю модуль как указано, он добавляет каждый файл .txt как новый лист, а не как новую строку к существующему листу. Есть ли способ добиться этого в качестве вывода вместо новых листов для каждого файла .txt?
Этот комментарий был сведен к минимуму модератором на сайте
Вы имеете в виду объединить весь текстовый файл в один лист?
Этот комментарий был сведен к минимуму модератором на сайте
Да вот и я тоже хочу.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Давиндер, вы можете попробовать приведенный ниже код vba.
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Код очень полезен, это единственный код, который я нашел, который получает txt-файлы в большом количестве, исправление, которое мне нужно, также является тем, что нужно Джойсу и Давиндеру.
Это извлечение файлов .txt и вставка их друг под другом в определенный столбец, скажем, столбец «N».

Кроме того, необходимо знать, можно ли будет добавить условие «если» для импортированных файлов .txt следующим образом.
если файлы .txt начинаются с буквы «A», их следует вставить на «лист 1», начиная с ячейки «N2»
и если файлы .txt начинаются с буквы «B», вставьте их на «Лист 2», начиная с ячейки «N2».
иначе MsgBox будет «Неопознанная цель файла .txt».

заранее спасибо
Этот комментарий был сведен к минимуму модератором на сайте
У меня этот код работал у меня, но все же мне нужно кое-что в нем изменить.

* Я хочу, чтобы он вставлялся на тот же лист, не открывая новый лист, а затем копировал его, так как это занимает больше времени.

* необходимо вставить условие, если импортированные текстовые файлы будут вставлены на лист 1, если они начинаются с буквы A, и импортированы на лист 2, если они начинаются с буквы B.


Подтестовая копия3()
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Dim i As Long
Dim LastRow As Long
Dim Rng As Range
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Если xFile="" Тогда
MsgBox «Файлы не найдены», vbInformation, «Kutools для Excel»
Exit Sub
End If
Делать, пока xFile <> ""
xFiles.Добавить xFile, xFile
xФайл = Каталог()
Петля
Диапазон("N2").Выбрать
Установите xToBook = ThisWorkbook
Если xFiles.Count > 0 Тогда
Для i = 1 в xFiles.Count
Установить xWb = Workbooks.Open(xStrPath и xFiles.Item(i))
xWb.Активировать
'Выбор и копирование данных txt
Диапазон (Selection, Selection.End (xlDown)). Выберите
Selection.Copy
xToBook.Активировать
ActiveSheet.Paste
Selection.End(xlDown).Offset(1).Select
On Error Resume Next
По ошибке GoTo 0
xWb.Close Ложь
Далее
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Извините, у меня связаны руки
Этот комментарий был сведен к минимуму модератором на сайте
Привет, мой код работает, но импортирует только первый файл. Пишет, что произошла ошибка метода копирования. Отладчик выделяет следующую строку кода. Любые идеи?


xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)
Этот комментарий был сведен к минимуму модератором на сайте
У меня такая же проблема, какие-то решения найдены?
Этот комментарий был сведен к минимуму модератором на сайте
Эй, Кэти,
Я знаю, что ваш комментарий довольно старый, но я столкнулся с той же проблемой и исправил ее следующим образом: модуль должен быть вставлен в подпапку активного проекта .xlsx. Я сделал ошибку, скопировав код в подпапку моего PERSONAL.XLSB, где я обычно храню свои макросы, и это происходит с другими моими макросами, но не с этим.
Этот комментарий был сведен к минимуму модератором на сайте
Как бы вы удалили листы в коде vba, если вам не нужны дубликаты при повторном выполнении модуля?
Этот комментарий был сведен к минимуму модератором на сайте
Извините, Харш, просто будьте осторожны, чтобы избежать повторного импорта.
Этот комментарий был сведен к минимуму модератором на сайте
привет, я хочу предотвратить удаление предшествующих нулей в excel.

я пробовал ниже код, но он не работает


Sub Test ()
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Дим я пока
Dim J As Long
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Если xFile="" Тогда
MsgBox «Файлы не найдены», vbInformation, «Kutools для Excel»
Exit Sub
End If
Делать, пока xFile <> ""
xFiles.Добавить xFile, xFile
xФайл = Каталог()
Петля
Установите xToBook = ThisWorkbook
Если xFiles.Count > 0 Тогда
Для I = 1 To xFiles.Count
Установить xWb = Workbooks.Open(xStrPath и xFiles.Item(I))
ActiveSheet.Cells.NumberFormat = "@" 'Это делается для преобразования excel в текстовый формат перед вставкой данных текстового файла.
xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
По ошибке GoTo 0
xWb.Close Ложь
Далее
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Пуджа, вы можете попробовать функцию «Удалить начальные нули» в Kutools for Excel, чтобы удалить все начальные нули из выбора после импорта.
Этот комментарий был сведен к минимуму модератором на сайте
а удалять не хочу. Я хочу предотвратить удаление предшествующих нулей.
Этот комментарий был сведен к минимуму модератором на сайте
Если вы хотите сохранить начальные нули, вы можете отформатировать их как текстовый формат с помощью формата ячейки.
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, как изменить этот код для вставки файлов *.txt в следующем порядке: 1,2,3,4,5,6,7,8,9,10,11 и т. д. В настоящее время код вставляет файлы следующим образом: 1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX и т. д. Спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
есть ли шанс взять имена листов только определенной части из имен файлов txt?

согласно приведенному выше коду принимается все имя листа.
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо! Работал на Office 2007 Excel.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, мой код работает, но импортирует только первый файл. Пишет, что произошла ошибка метода копирования. Отладчик выделяет следующую строку кода. Любые идеи?


xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)
Этот комментарий был сведен к минимуму модератором на сайте
Эй Мартиньо,
У меня была такая же проблема, и я решил ее, изменив эту строку:
Установите xToBook = ThisWorkbook
в
Установите xToBook = ActiveWorkbook
Может быть, это помогает.
Этот комментарий был сведен к минимуму модератором на сайте
0

мне нужна ваша помощь, я понятия не имею, vba excel, я хочу импортировать несколько текстовых файлов, таких как 13000. имя текстового файла такое же, как, например, ячейка (c1 = 112, поэтому имя текстового файла также 112) означает, что текстовый файл 112 импортировать c112.
Этот комментарий был сведен к минимуму модератором на сайте
мне нужна ваша помощь, я понятия не имею, vba excel, я хочу импортировать несколько текстовых файлов, таких как 13000. имя текстового файла такое же, как, например, ячейка (c1 = 112, поэтому имя текстового файла также 112) означает, что текстовый файл 112 импортировать c112.
Этот комментарий был сведен к минимуму модератором на сайте
Код работает, но каждый текстовый файл импортируется на новую вкладку в книге. Любая идея, где в коде это можно изменить, чтобы импортировать новый текстовый файл на тот же рабочий лист под данными из последнего текстового файла?
Этот комментарий был сведен к минимуму модератором на сайте
В приведенном ниже коде, если я хочу указать папку, а не выбирать путь каждый раз при импорте текстового файла, какую модификацию нужно сделать

КОД VBA:

Sub ImportCSVsWithReference()
«Обновление от Kutools forExcel20151214
Dim xSht как рабочий лист
Dim xWb как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
При ошибке Перейти к ErrHandler
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Установите xSht = ThisWorkbook.ActiveSheet
Если MsgBox("Очистить существующий лист перед импортом?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Приложение.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
Делать, пока xFile <> ""
Установите xWb = Workbooks.Open (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close Ложь
xФайл = Каталог
Петля
Application.ScreenUpdating = True
Exit Sub
Обработчик ошибок:
MsgBox «нет файлов txt», «Kutools for Excel»
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет, пожалуйста, попробуйте код ниже
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

«C:\Users\AddinsVM001\Desktop\test» — это путь к папке, из которой вы можете импортировать текстовый файл, измените его по своему усмотрению.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, спасибо за ваш ценный код VBA.
Однако мне нужен код для нескольких текстовых файлов в «один лист на рабочем листе, а не отдельный лист для каждого текстового файла».
Что я должен отредактировать ваш код для моей цели?

Благодаря,
Этот комментарий был сведен к минимуму модератором на сайте
Привет, пожалуйста, попробуйте код ниже
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Это прекрасно работает. Но когда он импортирует, он переименовывает листы с name.txt, как заставить его сохранить только имя, не добавляя к листу расширение .txt?
Номинальный 3.5 из 5
Этот комментарий был сведен к минимуму модератором на сайте
Хорошо, nvm нашел ответ с помощью Google.
заменить строку:
ActiveSheet.Name = xWb.Name
с:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
удалит последние 4 буквы из имени листа. Эффективно давая мне то, что мне нужно. имя без .txt
ура
Номинальный 4 из 5
Этот комментарий был сведен к минимуму модератором на сайте
приведенный ниже код может разбивать данные на столбцы на основе пробела или табуляции при импорте текстового файла на листы. Но мне не нужна отдельная вкладка для каждого текстового файла, я бы хотел, чтобы они все были на одном листе. Информация имеет одинаковый формат для каждого файла. . Что можно изменить, чтобы все это было одним листом вместо того, чтобы каждый импортированный файл был новой вкладкой, любая помощь будет оценена по достоинству.

Подпрограмма ImportTextToExcel()
'ОбновитьExtendoffice20180911
Dim xWb как рабочая книга
Dim xToBook как рабочая книга
Dim xStrPath как строка
Dim xFileDialog как FileDialog
Развернуть xFile как строку
Dim xFiles как новая коллекция
Дим я пока
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue как строка
Dim xRg как диапазон
Тусклый xArr
Установите xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Ложь
xFileDialog.Title = "Выберите папку [Kutools для Excel]"
Если xFileDialog.Show = -1 Тогда
xStrPath = xFileDialog.SelectedItems(1)
End If
Если xStrPath = "", то выйдите из Sub
Если Right(xStrPath, 1) <> "\" Тогда xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Если xFile="" Тогда
MsgBox «Файлы не найдены», vbInformation, «Kutools для Excel»
Exit Sub
End If
Делать, пока xFile <> ""
xFiles.Добавить xFile, xFile
xФайл = Каталог()
Петля
Установите xToBook = ThisWorkbook
On Error Resume Next
Приложение.ScreenUpdating = False
Если xFiles.Count > 0 Тогда

Для I = 1 To xFiles.Count
Установить xWb = Workbooks.Open(xStrPath и xFiles.Item(I))
xWb.Worksheets(1).Копировать после:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close Ложь
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Для xFNum = 1 Для xIntRow
Установите xRg = ActiveSheet.Range("A" & xFNum)
xArr = Разделить (xRg.Text, "")
Если UBound(xArr) > 0 Тогда
Для xFArr = 0 в UBound(xArr)
Если xArr(xFArr) <> "" Тогда
xRg.Value = xArr(xFArr)
Установите xRg = xRg.Offset (Смещение столбца: = 1)
End If
Далее
End If
Далее
Далее
End If
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Даниэль, попробуйте код ниже, он импортирует все текстовые файлы на один лист с именем Txt.
Обратите внимание: если текстовое имя совпадает с именем существующего листа, текстовый файл может быть не импортирован.
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL