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

Як імпортувати кілька текстових файлів з папки на один аркуш?

Наприклад, тут у вас є папка з кількома текстовими файлами, і ви хочете імпортувати ці текстові файли в один робочий аркуш, як показано нижче. Замість того, щоб копіювати текстові файли по одному, чи існують хитрощі для швидкого імпорту текстових файлів з однієї папки на один аркуш?

Імпортуйте кілька текстових файлів з однієї папки на один аркуш за допомогою VBA

Імпортуйте текстовий файл в активну комірку за допомогою Kutools для Excel гарна ідея3


Ось код VBA може допомогти вам імпортувати всі текстові файли з однієї конкретної папки на новий аркуш.

1. Увімкніть книгу, до якої потрібно імпортувати текстові файли, та натисніть Alt + F11 клавіші для ввімкнення Microsoft Visual Basic для додатків вікна.

2. клацання Insert > Модулі, скопіюйте та вставте нижче код 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 для ExcelАвтора Вставити файл у курсор утиліта

Kutools для Excel, з більш ніж 300 зручні функції, полегшує вам роботу. 

після безкоштовна установка Kutools для Excel, будь-ласка, виконайте наведені нижче дії:

1. Виділіть комірку, до якої потрібно імпортувати текстовий файл, і натисніть Kutools Plus > Імпорт-експорт > Вставити файл у курсор. Дивіться знімок екрана:
doc імпортувати текстові файли з папки 3

2. Потім з’явиться діалогове вікно, натисніть перегорнути щоб відобразити Виберіть файл щоб вставити в діалогове вікно положення курсора комірки, виберіть наступний Текстові файли зі спадного списку, а потім виберіть текстовий файл, який потрібно імпортувати. Дивіться знімок екрана:
doc імпортувати текстові файли з папки 4

3. клацання відкритий > Ok, а вказаний текстовий файл було вставлено в позицію курсора, див. знімок екрана:
doc імпортувати текстові файли з папки 5


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

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

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (46)
Оцінено 4 з 5 · рейтинги 1
Цей коментар був мінімізований модератором на сайті
Суб-тест ()
'ОновленняExtendoffice6/7/2016
Dim xWb як робочий зошит
Dim xToBook як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Dim xFiles як нова колекція
Dim I As Long
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Виберіть папку [Kutools for 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
xFile = Dir()
Петля
Встановіть xToBook = ThisWorkbook
Якщо xFiles.Count > 0 Тоді
Для I = 1 До 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 False
Далі
End If
End Sub

цей код допомагає, але я хочу

tab, крапка з комою, пробіл істина, як це зробити, будь ласка, допоможіть мені
Цей коментар був мінімізований модератором на сайті
Ви хочете зберегти пробіл (роздільники) після перетворення текстових файлів на аркуші?
Цей коментар був мінімізований модератором на сайті
це також моя проблема, цей код вірний. але після перетворення текстових файлів у Excel він не зберігає роздільники.
Цей коментар був мінімізований модератором на сайті
Не могли б ви завантажити текстовий файл і результат, який ви хочете для мене?
Цей коментар був мінімізований модератором на сайті
У мене така ж проблема. Файли txt розміщені на окремих аркушах, і код ігнорує простір між двома стовпцями
Цей коментар був мінімізований модератором на сайті
Привіт, Des і PB Rama Murty, наведений нижче код може розділити дані на стовпці на основі пробілу або табуляції під час імпортування текстового файлу на аркуші. Ви можете спробувати.

Sub ImportTextToExcel()
'ОновленняExtendoffice20180911
Dim xWb як робочий зошит
Dim xToBook як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Dim xFiles як нова колекція
Dim I As Long
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue як рядок
Dim xRg As Range
Дим xArr
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Виберіть папку [Kutools for 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
xFile = Dir()
Петля
Встановіть xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Невірний
Якщо xFiles.Count > 0 Тоді

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

ActiveSheet.Name = xWb.Name

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

і цей, який використовує пробіли для dd до кожного стовпця

Sub ImportTextToExcel()
'ОновленняExtendoffice20180911
Dim xWb як робочий зошит
Dim xToBook як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Dim xFiles як нова колекція
Dim I As Long
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue як рядок
Dim xRg As Range
Дим xArr
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Виберіть папку [Kutools for 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
xFile = Dir()
Петля
Встановіть xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Невірний
Якщо xFiles.Count > 0 Тоді

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

ActiveSheet.Name = xWb.Name

xWb. Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Для xFNum = 1 до xIntRow
Встановіть xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Якщо UBound(xArr) > 0, то
Для xFArr = 0 до UBound(xArr)
Якщо xArr(xFArr) <> "" Тоді
xRg.Value = xArr(xFArr)
Встановити xRg = xRg.Offset(ColumnOffset:=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".

спасибі заздалегідь
Цей коментар був мінімізований модератором на сайті
У мене цей код спрацював, але все одно мені потрібно щось змінити.

*Я хочу вставити його на той самий аркуш, не відкриваючи новий аркуш, а потім скопіювати його, оскільки це займає більше часу.

*потрібно вставити умову if для імпортованих txt-файлів, які потрібно вставити на аркуш 1, якщо він починається з літери A, і імпортувати на аркуш 2, якщо він починається з літери B


Додаткова тестова копія3()
Dim xWb як робочий зошит
Dim xToBook як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Dim xFiles як нова колекція
Dim i As Long
Приглушений останній рядок
Dim Rng як дальність
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Виберіть папку [Kutools for 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
xFile = Dir()
Петля
Діапазон ("N2"). Виберіть
Встановіть xToBook = ThisWorkbook
Якщо xFiles.Count > 0 Тоді
Для i = 1 До xFiles.Count
Установіть xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb.Активувати
'Вибір і копіювання даних txt
Діапазон(Вибір, Вибір. Кінець(xlDown)).Вибрати
Вибір. Копіювати
xToBook.Активувати
ActiveSheet.Paste
Виділення.Кінець(xlDown).Зміщення(1).Вибір
On Error Resume Next
При помилці GoTo 0
xWb. Close False
Далі
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Вибачте, у мене зв’язані руки
Цей коментар був мінімізований модератором на сайті
Привіт, мій код працює, але імпортує лише перший файл. Він каже, що сталася помилка методу для копіювання. Налагоджувач виділяє наступний рядок коду. Є ідеї?


xWb.Worksheets(1).Копіювати після:=xToBook.Sheets(xToBook.Sheets.Count)
Цей коментар був мінімізований модератором на сайті
У мене така ж проблема, знайдено якісь рішення?
Цей коментар був мінімізований модератором на сайті
Гей, Кеті,
Я знаю, що ваш коментар досить старий, але я зіткнувся з тією ж проблемою і вирішив її таким чином: модуль потрібно вставити у підпапку активного проекту .xlsx. Я зробив помилку, скопіювавши код у підпапку мого PERSONAL.XLSB, де я зазвичай зберігаю свої макроси, і це відбувається з іншими моїми макросами, але не з цим.
Цей коментар був мінімізований модератором на сайті
Як би ви видалили аркуші в коді vba, якщо вам не потрібні дублікати під час повторного виконання модуля?
Цей коментар був мінімізований модератором на сайті
Вибачте, Гарш, просто будьте обережні, щоб уникнути повторного імпорту.
Цей коментар був мінімізований модератором на сайті
привіт, я хочу запобігти видаленню попередніх нулів у Excel.

Я спробував код нижче, але він не працює


Суб-тест ()
Dim xWb як робочий зошит
Dim xToBook як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Dim xFiles як нова колекція
Dim I As Long
Dim j Як довго
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
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
xFile = Dir()
Петля
Встановіть xToBook = ThisWorkbook
Якщо xFiles.Count > 0 Тоді
Для I = 1 До 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 False
Далі
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

Мені потрібна ваша допомога, я не маю жодного уявлення o vba excel, я хочу імпортувати декілька текстових файлів, наприклад 13000. Ім'я текстового файлу таке ж, як і клітинка, наприклад (c1=112, тому ім'я текстового файлу також 112) означає, що текстовий файл 112 є імпортувати c112.
Цей коментар був мінімізований модератором на сайті
Мені потрібна ваша допомога, я не маю жодного уявлення o vba excel, я хочу імпортувати декілька текстових файлів, наприклад 13000. Ім'я текстового файлу таке ж, як і клітинка, наприклад (c1=112, тому ім'я текстового файлу також 112) означає, що текстовий файл 112 є імпортувати c112.
Цей коментар був мінімізований модератором на сайті
Код працює, але імпортує кожен текстовий файл на нову вкладку в книзі. Будь-яка ідея, де в коді це можна змінити, щоб імпортувати новий текстовий файл на той самий аркуш під даними з останнього текстового файлу?
Цей коментар був мінімізований модератором на сайті
У наведеному нижче коді, якщо я хочу вказати папку, а не вибирати шлях щоразу під час імпорту текстового файлу, яку зміну потрібно зробити

КОД VBA:

Sub ImportCSVsWithReference()
«Оновлення за допомогою Kutools для Excel20151214
Dim xSht як аркуш
Dim xWb як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Помилка GoTo ErrHandler
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Виберіть папку [Kutools for Excel]"
Якщо xFileDialog.Show = -1 Тоді
xStrPath = xFileDialog.SelectedItems(1)
End If
Якщо xStrPath = "" Вийдіть із Sub
Установіть xSht = ThisWorkbook.ActiveSheet
Якщо MsgBox("Очистити наявний аркуш перед імпортом?", vbYesNo, "Kutools для Excel") = vbYes Тоді xSht.UsedRange.Clear
Application.ScreenUpdating = Невірний
xFile = Dir(xStrPath & "\" & "*.txt")
Робити, поки xFile <> ""
Установіть xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb. Close False
xFile = Dir
Петля
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "немає текстових файлів", , "Kutools для 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
Цей коментар був мінімізований модератором на сайті
наведений нижче код може розділити дані на стовпці на основі пробілу або табуляції під час імпорту текстового файлу на аркуші. Але я не хочу окрему вкладку для кожного текстового файлу, я хотів би, щоб усі вони були на одному аркуші. Інформація має однаковий формат для кожного файлу. . Що можна змінити, щоб це було одним аркушем замість того, щоб кожен імпортований файл був новою вкладкою, будь-яка допомога буде вдячна

Sub ImportTextToExcel()
'ОновленняExtendoffice20180911
Dim xWb як робочий зошит
Dim xToBook як робочий зошит
Dim xStrPath як рядок
Dim xFileDialog як FileDialog
Dim xFile як рядок
Dim xFiles як нова колекція
Dim I As Long
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue як рядок
Dim xRg As Range
Дим xArr
Встановіть xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Виберіть папку [Kutools for 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
xFile = Dir()
Петля
Встановіть xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Невірний
Якщо xFiles.Count > 0 Тоді

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

ActiveSheet.Name = xWb.Name

xWb. Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Для xFNum = 1 до xIntRow
Встановіть xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Якщо UBound(xArr) > 0, то
Для xFArr = 0 до UBound(xArr)
Якщо xArr(xFArr) <> "" Тоді
xRg.Value = xArr(xFArr)
Встановити xRg = xRg.Offset(ColumnOffset:=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


There are no comments posted here yet
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця

Слідуй за нами

Copyright © 2009 - WWW.extendoffice.com. | Всі права захищені. На основі ExtendOffice. | Карта сайту
Microsoft та логотип Office є товарними знаками або зареєстрованими товарними знаками Microsoft Corporation у США та / або інших країнах.
Захищений Sectigo SSL