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

Jak zaimportować wiele plików tekstowych z folderu do jednego arkusza?

Na przykład tutaj masz folder z wieloma plikami tekstowymi, co chcesz zrobić, to zaimportować te pliki tekstowe do jednego arkusza roboczego, jak pokazano poniżej. Czy zamiast kopiować pliki tekstowe jeden po drugim, są jakieś sztuczki, aby szybko importować pliki tekstowe z jednego folderu do jednego arkusza?

Importuj wiele plików tekstowych z jednego folderu do jednego arkusza za pomocą VBA

Importuj plik tekstowy do aktywnej komórki za pomocą Kutools for Excel dobry pomysł 3


Oto kod VBA, który pomoże Ci zaimportować wszystkie pliki tekstowe z jednego określonego folderu do nowego arkusza.

1. Włącz skoroszyt, do którego chcesz importować pliki tekstowe, i naciśnij Alt + F11 klucze do włączenia Microsoft Visual Basic for Applications okno.

2. kliknij wstawka > Moduł, skopiuj i wklej poniższy kod VBA do pliku Moduł okno.

VBA: Importuj wiele plików tekstowych z jednego folderu do jednego arkusza

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. naciśnij F5 aby wyświetlić okno dialogowe i wybierz folder zawierający pliki tekstowe, które chcesz zaimportować. Zobacz zrzut ekranu:
doc importuj pliki tekstowe z folderu 1

4. kliknij OK. Następnie pliki tekstowe zostały zaimportowane do aktywnego skoroszytu oddzielnie jako nowy arkusz.
doc importuj pliki tekstowe z folderu 2


Jeśli chcesz zaimportować jeden plik tekstowy do określonej komórki lub zakresu, możesz zastosować Kutools dla programu Excel'S Wstaw plik do kursora użyteczność.

Kutools dla programu Excel, ponad 300 przydatne funkcje, ułatwiają pracę. 

Po bezpłatna instalacja Kutools dla programu Excel, wykonaj poniższe czynności:

1. Wybierz komórkę, do której chcesz zaimportować plik tekstowy, i kliknij Kutools Plus > Import Eksport > Wstaw plik do kursora. Zobacz zrzut ekranu:
doc importuj pliki tekstowe z folderu 3

2. Następnie pojawi się okno dialogowe, kliknij Przeglądaj wyświetlić Wybierz plik do wstawienia w oknie dialogowym pozycji kursora komórki, następnie wybierz Pliki tekstowe z listy rozwijanej, a następnie wybierz plik tekstowy, który chcesz zaimportować. Zobacz zrzut ekranu:
doc importuj pliki tekstowe z folderu 4

3. kliknij Otwarte > Ok, a określony plik tekstowy został wstawiony w pozycji kursora, patrz zrzut ekranu:
doc importuj pliki tekstowe z folderu 5


Najlepsze narzędzia biurowe

Kutools dla programu Excel rozwiązuje większość problemów i zwiększa produktywność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2021 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowa bezpłatna wersja próbna. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół
Sortuj komentarze według
Komentarze (46)
Znamionowy 4 z 5 · 1 oceny
Ten komentarz został zminimalizowany przez moderatora na stronie
Sub Test ()
„Aktualizuj do”Extendoffice6 / 7 / 2016
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Dim I tak długo
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Jeśli xFile = „” Wtedy
MsgBox "Nie znaleziono plików", vbInformation, "Kutools for Excel"
Exit Sub
End If
Rób, gdy xFile <> ""
xFiles.Dodaj xFile, xFile
xPlik = Katalog()
Pętla
Ustaw xToBook = ThisWorkbook
Jeśli xFiles.Count > 0 Wtedy
Dla I = 1 To xFiles.Count
Ustaw xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Nazwa
Przy błędzie GoTo 0
xWb.Zamknij Fałsz
Dalej
End If
End Sub

ten kod pomaga, ale chcę

tabulator, średnik, spacja prawda jak to zrobić proszę o pomoc
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy chcesz zachować spację (ograniczniki) po konwersji plików tekstowych na arkusze?
Ten komentarz został zminimalizowany przez moderatora na stronie
to też jest mój problem, ten kod jest prawdziwy. ale po konwersji plików tekstowych do programu Excel nie zachowuje ograniczników.
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy możesz przesłać plik tekstowy i wynik, który chcesz dla mnie?
Ten komentarz został zminimalizowany przez moderatora na stronie
Mam ten sam problem. Wszystkie pliki txt znajdują się w osobnych arkuszach, a kod ignoruje spację między dwiema kolumnami
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, Des i PB Rama Murty, poniższy kod potrafi podzielić dane na kolumny w oparciu o spację lub tabulator podczas importowania pliku tekstowego do arkuszy. Możesz spróbować.

Sub ImportTextToExcel()
„Aktualizuj do”Extendoffice20180911
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Dim I tak długo
Dim xIntRow tak długo
Wym. xFNum, xFArr Tak długo
Dim xStrValue jako ciąg
Dim xRg jako zakres
Przyciemnij xArr
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Jeśli xFile = „” Wtedy
MsgBox "Nie znaleziono plików", vbInformation, "Kutools for Excel"
Exit Sub
End If
Rób, gdy xFile <> ""
xFiles.Dodaj xFile, xFile
xPlik = Katalog()
Pętla
Ustaw xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Fałsz
Jeśli xFiles.Count > 0 Wtedy

Dla I = 1 To xFiles.Count
Ustaw xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Nazwa

xWb.Zamknij Fałsz
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Dla xFNum = 1 do xIntRow
Ustaw xRg = ActiveSheet.Range("A" i xFNum)
xArr = Podziel (xRg.Tekst, " ")
Jeśli UBound(xArr) > 0 Wtedy
Dla xFArr = 0 To UBound(xArr)
Jeśli xArr(xFArr) <> "" Wtedy
xRg.Wartość = xArr(xFArr)
Ustaw xRg = xRg.Przesunięcie(Przesunięcie kolumny:=1)
End If
Dalej
End If
Dalej
Dalej
End If
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Jakie zmiany są potrzebne, jeśli chcesz podzielić dane na kolumny na podstawie przecinka?
Ten komentarz został zminimalizowany przez moderatora na stronie
Jakie zmiany należy wprowadzić, jeśli muszę zsumować dane w kolumnach na podstawie przecinka?
Ten komentarz został zminimalizowany przez moderatora na stronie
Użyłem tego i działa, ale chciałbym, aby wszystko zostało zapisane w jednym arkuszu, ponieważ każdy arkusz zawiera te same informacje, które są tylko plikami dziennika z każdego dnia.
więc muszę połączyć
wszystkie elementy w folderze na jednym arkuszu
Sub Import CSVsWithReference()
„Aktualizacja przez Kutools dla programu Excel20151214”
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Dim I tak długo
Dim xIntRow tak długo
Wym. xFNum, xFArr Tak długo
Dim xStrValue jako ciąg
Dim xRg jako zakres
Przyciemnij xArr
W przypadku błędu przejdź do obsługi błędów
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
Ustaw xSht = ThisWorkbook.ActiveSheet
If MsgBox("Wyczyścić istniejący arkusz przed importowaniem?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = Fałsz
xFile = Dir(xStrPath & "\" & "*.log")
Rób, gdy xFile <> ""
Ustaw xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Zamknij Fałsz
xPlik = Katalog
Pętla
Application.ScreenUpdating = True
Exit Sub
Obsługa błędów:
MsgBox "brak plików txt", , "Kutools for Excel"
End Sub

i ten, który używa spacji do dd do każdej kolumny

Sub ImportTextToExcel()
„Aktualizuj do”Extendoffice20180911
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Dim I tak długo
Dim xIntRow tak długo
Wym. xFNum, xFArr Tak długo
Dim xStrValue jako ciąg
Dim xRg jako zakres
Przyciemnij xArr
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Jeśli xFile = „” Wtedy
MsgBox "Nie znaleziono plików", vbInformation, "Kutools for Excel"
Exit Sub
End If
Rób, gdy xFile <> ""
xFiles.Dodaj xFile, xFile
xPlik = Katalog()
Pętla
Ustaw xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Fałsz
Jeśli xFiles.Count > 0 Wtedy

Dla I = 1 To xFiles.Count
Ustaw xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Nazwa

xWb.Zamknij Fałsz
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Dla xFNum = 1 do xIntRow
Ustaw xRg = ActiveSheet.Range("A" i xFNum)
xArr = Podziel (xRg.Tekst, " ")
Jeśli UBound(xArr) > 0 Wtedy
Dla xFArr = 0 To UBound(xArr)
Jeśli xArr(xFArr) <> "" Wtedy
xRg.Wartość = xArr(xFArr)
Ustaw xRg = xRg.Przesunięcie(Przesunięcie kolumny:=1)
End If
Dalej
End If
Dalej
Dalej
End If
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
jak to zrobić, jeśli mój plik Txt zawiera rozdzielone przecinkami?
Ten komentarz został zminimalizowany przez moderatora na stronie
Możesz użyć funkcji Znajdź i zamień, aby najpierw zastąpić przecinek spacją, a następnie zastosować jedną z powyższych metod, aby przekonwertować go na plik Excel.
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy nie ma sposobu, aby to zmienić w kodzie? Musiałbym to zrobić ze 130 plikami
Ten komentarz został zminimalizowany przez moderatora na stronie
To samo pytanie
Ten komentarz został zminimalizowany przez moderatora na stronie
Dla tych, którzy nadal potrzebują pomocy, zamień xArr = Split(xRg.Text, " ") na xArr = Split(xRg.Text, ",").
Ten komentarz został zminimalizowany przez moderatora na stronie
Kiedy uruchamiam moduł, jak podano, dodaje każdy plik .txt jako nowy arkusz, a nie jako nową linię do istniejącego arkusza. Czy istnieje sposób, aby to osiągnąć jako wynik zamiast nowych arkuszy dla każdego pliku .txt?
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy masz na myśli połączenie całego pliku tekstowego w jeden arkusz?
Ten komentarz został zminimalizowany przez moderatora na stronie
Tak, tego też chcę.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Davinder, możesz wypróbować poniższy kod 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
Ten komentarz został zminimalizowany przez moderatora na stronie
Kod jest bardzo pomocny, jest to jedyny kod, który znalazłem, który pobiera masowo pliki txt, poprawka, której potrzebuję, jest również tym, czego szukają Joyce i Davinder.
Ma to na celu wyodrębnienie plików .txt i wklejenie ich wszystkich pod sobą w określonej kolumnie, powiedzmy, kolumnie „N”.

Musisz także wiedzieć, czy będzie możliwe dodanie warunku „jeśli” dla importowanych plików .txt, aby wyglądały następująco.
jeśli pliki .txt zaczynają się na literę „A”, należy je wkleić do „arkusza 1”, zaczynając od komórki „N2”
a jeśli pliki .txt zaczynają się na literę „B”, wklej w „Arkuszu 2”, zaczynając od komórki „N2”
w przeciwnym razie MsgBox ma być „Nierozpoznany cel pliku .txt”.

z góry dziękuję
Ten komentarz został zminimalizowany przez moderatora na stronie
Ten kod zadziałał dla mnie, ale nadal muszę w nim coś zmienić.

*Chcę go wkleić na tym samym arkuszu bez otwierania nowego arkusza, a następnie skopiować, ponieważ zajmuje to więcej czasu.

*należy wstawić warunek, jeśli importowane pliki txt mają być wklejone na arkuszu 1, jeśli zaczyna się na literę A i importowane do arkusza 2, jeśli zaczyna się na literę B


Pod kopia testowa3()
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Przyciemnij i tak długo
Dim LastRow tak długo
Dim Rng jako zakres
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Jeśli xFile = „” Wtedy
MsgBox "Nie znaleziono plików", vbInformation, "Kutools for Excel"
Exit Sub
End If
Rób, gdy xFile <> ""
xFiles.Dodaj xFile, xFile
xPlik = Katalog()
Pętla
Zakres ("N2"). Wybierz
Ustaw xToBook = ThisWorkbook
Jeśli xFiles.Count > 0 Wtedy
Dla i = 1 To xFiles.Count
Ustaw xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb.Aktywuj
'Wybieranie i kopiowanie danych txt'
Zakres (Wybór, Wybór. Koniec (xlDown)). Wybierz
Selection.Copy
xToBook.Aktywuj
ActiveSheet.Paste
Wybór.Koniec(xlDown).Przesunięcie(1).Wybierz
On Error Resume Next
Przy błędzie GoTo 0
xWb.Zamknij Fałsz
Dalej
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Przepraszam, mam związane ręce
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, mój kod działa, ale importuje tylko pierwszy plik. Mówi, że wystąpił błąd metody kopiowania. Debuger podświetla następujący wiersz kodu. Jakieś pomysły?


xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)
Ten komentarz został zminimalizowany przez moderatora na stronie
Mam ten sam problem, znaleziono jakieś rozwiązania?
Ten komentarz został zminimalizowany przez moderatora na stronie
Hej Katie,
Wiem, że Twój komentarz jest dość stary, ale napotkałem ten sam problem i naprawiłem go w ten sposób: Moduł należy wstawić do podfolderu aktywnego projektu .xlsx. Popełniłem błąd, kopiując kod do podfolderu mojego PERSONAL.XLSB, gdzie zwykle przechowuję moje makra i robi to z innymi moimi makrami, ale nie z tym.
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak usunąć arkusze w kodzie vba, jeśli nie chcesz duplikatów przy ponownym wykonywaniu modułu?
Ten komentarz został zminimalizowany przez moderatora na stronie
Przepraszam, szorstko, po prostu uważaj, aby uniknąć wielokrotnego importowania.
Ten komentarz został zminimalizowany przez moderatora na stronie
cześć chcę zapobiec usuwaniu poprzedzających zer w programie Excel.

Próbowałem poniższego kodu, ale nie działa


Sub Test ()
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Dim I tak długo
Dim j Jak długo
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Jeśli xFile = „” Wtedy
MsgBox "Nie znaleziono plików", vbInformation, "Kutools for Excel"
Exit Sub
End If
Rób, gdy xFile <> ""
xFiles.Dodaj xFile, xFile
xPlik = Katalog()
Pętla
Ustaw xToBook = ThisWorkbook
Jeśli xFiles.Count > 0 Wtedy
Dla I = 1 To xFiles.Count
Ustaw xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
ActiveSheet.Cells.NumberFormat = "@" 'To ma na celu utworzenie programu Excel w formacie tekstowym przed wklejeniem danych pliku tekstowego
xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Nazwa
Przy błędzie GoTo 0
xWb.Zamknij Fałsz
Dalej
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Pooja, możesz wypróbować funkcję Usuń wiodące zera w Kutools dla programu Excel, aby usunąć wszystkie wiodące zera z zaznaczenia po zaimportowaniu.
Ten komentarz został zminimalizowany przez moderatora na stronie
ale nie chcę usuwać. Chcę zapobiec usuwaniu poprzedzających zer.
Ten komentarz został zminimalizowany przez moderatora na stronie
Jeśli chcesz zachować wiodące zera, możesz je sformatować jako format tekstowy według formatu komórki.
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, jak zmodyfikować ten kod, aby wstawić pliki *.txt w kolejności: 1,2,3,4,5,6,7,8,9,10,11 itd. Obecnie kod wstawia pliki w następujący sposób:1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX itd. Dzięki!
Ten komentarz został zminimalizowany przez moderatora na stronie
czy jest jakaś szansa na pobranie nazw arkuszy tylko pewnej części z nazw plików txt?

zgodnie z powyższym kodem została przyjęta cała nazwa arkusza.
Ten komentarz został zminimalizowany przez moderatora na stronie
wielkie dzięki za pracę w biurze 2007 excel
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, mój kod działa, ale importuje tylko pierwszy plik. Mówi, że wystąpił błąd metody kopiowania. Debuger podświetla następujący wiersz kodu. Jakieś pomysły?


xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)
Ten komentarz został zminimalizowany przez moderatora na stronie
Hej Martinho,
Miałem ten sam problem i rozwiązałem go, zmieniając tę ​​linię:
Ustaw xToBook = ThisWorkbook
do
Ustaw xToBook = ActiveWorkbook
Może to pomaga.
Ten komentarz został zminimalizowany przez moderatora na stronie
0

potrzebuję twojej pomocy nie mam żadnego pomysłu vba excel chcę zaimportować wiele plików tekstowych, takich jak 13000. nazwa pliku tekstowego taka sama jak na przykład komórka (c1 = 112, więc nazwa pliku tekstowego to również 112) oznacza, że ​​plik tekstowy 112 jest importuj c112.
Ten komentarz został zminimalizowany przez moderatora na stronie
potrzebuję twojej pomocy nie mam żadnego pomysłu vba excel chcę zaimportować wiele plików tekstowych, takich jak 13000. nazwa pliku tekstowego taka sama jak na przykład komórka (c1 = 112, więc nazwa pliku tekstowego to również 112) oznacza, że ​​plik tekstowy 112 jest importuj c112.
Ten komentarz został zminimalizowany przez moderatora na stronie
Kod działa, ale importuje każdy plik tekstowy do nowej karty w skoroszycie. Masz pomysł, gdzie w kodzie można to zmienić, aby zaimportować nowy plik tekstowy w tym samym arkuszu poniżej danych z ostatniego pliku tekstowego?
Ten komentarz został zminimalizowany przez moderatora na stronie
W poniższym kodzie, jeśli chcę określić folder zamiast wybierać ścieżkę za każdym razem importować plik tekstowy, jakie modyfikacje mają do zrobienia

KOD VBA:

Sub Import CSVsWithReference()
„Aktualizacja przez Kutools dla programu Excel20151214”
Dim xSht jako arkusz
Dim xWb jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
W przypadku błędu przejdź do obsługi błędów
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Ustaw xSht = ThisWorkbook.ActiveSheet
If MsgBox("Wyczyścić istniejący arkusz przed importowaniem?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = Fałsz
xFile = Dir(xStrPath & "\" & "*.txt")
Rób, gdy xFile <> ""
Ustaw xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Zamknij Fałsz
xPlik = Katalog
Pętla
Application.ScreenUpdating = True
Exit Sub
Obsługa błędów:
MsgBox "brak plików txt", , "Kutools for Excel"
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, wypróbuj poniższy kod
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” to ścieżka folderu, z którego możesz importować plik tekstowy, zmień ją według potrzeb.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, dziękuję za cenny kod VBA.
Potrzebuję jednak kodu dla wielu plików txt w „jednym arkuszu w arkuszu, a nie w osobnym arkuszu dla każdego pliku txt”.
Co powinienem edytować twój kod do mojego celu?

Dzięki,
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, wypróbuj poniższy kod
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
Ten komentarz został zminimalizowany przez moderatora na stronie
To działa dobrze. Ale kiedy importuje, zmienia nazwy arkuszy na name.txt, jak sprawić, by zachował tylko nazwę bez dodawania rozszerzenia .txt do arkusza?
Znamionowy 3.5 z 5
Ten komentarz został zminimalizowany przez moderatora na stronie
Ok nvm znalazł odpowiedź z pomocą Google.
zastąpić linię:
ActiveSheet.Name = xWb.Nazwa
z:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
usunie ostatnie 4 litery z nazwy arkusza. Skutecznie dając mi to, czego potrzebowałem. nazwa bez .txt
Namaste
Znamionowy 4 z 5
Ten komentarz został zminimalizowany przez moderatora na stronie
poniższy kod może podzielić dane na kolumny na podstawie spacji lub tabulacji podczas importowania pliku tekstowego do arkuszy. Ale nie chcę osobnej karty dla każdego pliku txt, chciałbym je wszystkie pod jednym arkuszem. Informacje mają ten sam format dla każdego pliku. . Co można zmodyfikować, aby był to jeden arkusz, zamiast każdego importowanego pliku jako nowej karty, każda pomoc byłaby mile widziana

Sub ImportTextToExcel()
„Aktualizuj do”Extendoffice20180911
Dim xWb jako skoroszyt
Dim xToBook jako skoroszyt
Dim xStrPath jako ciąg
Dim xFileDialog jako FileDialog
Dim xFile jako ciąg
Dim xFiles jako nowa kolekcja
Dim I tak długo
Dim xIntRow tak długo
Wym. xFNum, xFArr Tak długo
Dim xStrValue jako ciąg
Dim xRg jako zakres
Przyciemnij xArr
Ustaw xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Fałsz
xFileDialog.Title = "Wybierz folder [Kutools for Excel]"
Jeśli xFileDialog.Show = -1 Wtedy
xStrPath = xFileDialog.SelectedItems(1)
End If
Jeśli xStrPath = "" Następnie wyjdź z Sub
Jeśli Right(xStrPath, 1) <> "\" Wtedy xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Jeśli xFile = „” Wtedy
MsgBox "Nie znaleziono plików", vbInformation, "Kutools for Excel"
Exit Sub
End If
Rób, gdy xFile <> ""
xFiles.Dodaj xFile, xFile
xPlik = Katalog()
Pętla
Ustaw xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Fałsz
Jeśli xFiles.Count > 0 Wtedy

Dla I = 1 To xFiles.Count
Ustaw xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopiuj po:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Nazwa

xWb.Zamknij Fałsz
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Dla xFNum = 1 do xIntRow
Ustaw xRg = ActiveSheet.Range("A" i xFNum)
xArr = Podziel (xRg.Tekst, " ")
Jeśli UBound(xArr) > 0 Wtedy
Dla xFArr = 0 To UBound(xArr)
Jeśli xArr(xFArr) <> "" Wtedy
xRg.Wartość = xArr(xFArr)
Ustaw xRg = xRg.Przesunięcie(Przesunięcie kolumny:=1)
End If
Dalej
End If
Dalej
Dalej
End If
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Daniel, wypróbuj poniższy kod, importuje wszystkie pliki tekstowe w jednym arkuszu o nazwie Txt.
Uwaga: jeśli nazwa tekstu jest taka sama jak nazwa istniejącego arkusza, plik tekstowy może nie zostać zaimportowany.
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


Nie ma tu jeszcze żadnych komentarzy

Bądż na bieżąco

Prawa autorskie © 2009 - www.extendoffice.com. | Wszelkie prawa zastrzeżone. Zasilany przez ExtendOffice, | Mapa strony
Microsoft i logo Office są znakami towarowymi lub zastrzeżonymi znakami towarowymi Microsoft Corporation w Stanach Zjednoczonych i / lub innych krajach.
Chronione przez Sectigo SSL