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

Wie importiere ich mehrere Textdateien aus einem Ordner in ein Arbeitsblatt?

Hier haben Sie beispielsweise einen Ordner mit mehreren Textdateien. Sie möchten diese Textdateien in ein einzelnes Arbeitsblatt importieren, wie in der folgenden Abbildung dargestellt. Gibt es Tricks, um die Textdateien schnell aus einem Ordner in ein Blatt zu importieren, anstatt die Textdateien einzeln zu kopieren?

Importieren Sie mit VBA mehrere Textdateien aus einem Ordner in ein einzelnes Blatt

Importieren Sie mit Kutools for Excel eine Textdatei in die aktive Zelle gute Idee3


Mit diesem VBA-Code können Sie alle Textdateien aus einem bestimmten Ordner in ein neues Blatt importieren.

1. Aktivieren Sie eine Arbeitsmappe, in die Sie Textdateien importieren möchten, und drücken Sie Alt + F11 zu aktivierende Tasten Microsoft Visual Basic für Applikationen Fenster.

2 Klicken Insert > ModulKopieren Sie den folgenden VBA-Code und fügen Sie ihn in den ein Modul Fenster.

VBA: Importieren Sie mehrere Textdateien aus einem Ordner in ein Blatt

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. Drücken Sie F5 um ein Dialogfeld anzuzeigen und einen Ordner auszuwählen, der Textdateien enthält, die Sie importieren möchten. Siehe Screenshot:
doc importiert Textdateien aus einem Ordner 1

4 Klicken OK. Anschließend wurden die Textdateien separat als neues Blatt in die aktive Arbeitsmappe importiert.
doc importiert Textdateien aus einem Ordner 2


Wenn Sie eine Textdatei in eine bestimmte Zelle oder einen bestimmten Bereich importieren möchten, können Sie anwenden Kutools for Excel Datei am Cursor einfügen Dienstprogramm.

Kutools for Excel, mit mehr als 300 praktische Funktionen erleichtern Ihre Arbeit. 

Nachher kostenlose Installation Kutools für Excel, bitte gehen Sie wie folgt vor:

1. Wählen Sie eine Zelle aus, in die Sie die Textdatei importieren möchten, und klicken Sie auf Kutoolen Plus > Import Export > Datei am Cursor einfügen. Siehe Screenshot:
doc importiert Textdateien aus einem Ordner 3

2. Dann erscheint ein Dialogfeld, klicken Sie auf Entdecken um das anzuzeigen Wählen Sie eine Datei aus Um im Dialogfeld für die Position des Zellencursors eingefügt zu werden, wählen Sie als nächstes Textdateien Wählen Sie dann aus der Dropdown-Liste die Textdatei aus, die Sie importieren möchten. Siehe Screenshot:
doc importiert Textdateien aus einem Ordner 4

3 Klicken Offen > Okund die angegebene Textdatei wurde an der Cursorposition eingefügt, siehe Screenshot:
doc importiert Textdateien aus einem Ordner 5


Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formelriegel (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2021 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. 30-tägige kostenlose Testversion mit allen Funktionen. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
officetab unten
Kommentare (46)
Bewertet 4 aus 5 · 1 Bewertungen
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Untertest ()
'UpdatebyExtendoffice6/7/2016
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dimme ich so lange
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Wenn xFile = "" Dann
MsgBox "Keine Dateien gefunden", vbInformation, "Kutools für Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xDatei = Dir()
Loop
Legen Sie xToBook = DieseArbeitsmappe fest
Wenn xFiles.Count > 0 dann
Für I = 1 bis xFiles.Count
Setze xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
Bei Fehler GoTo 0
xWb.Close Falsch
Weiter
End If
End Sub

Dieser Code hilft, aber ich will

Tabulator, Semikolon, Leerzeichen wahr, wie das geht, bitte helfen Sie mir
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Möchten Sie die Leerzeichen (Trennzeichen) beibehalten, nachdem Sie die Textdateien in Blätter konvertiert haben?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Das ist auch mein Problem, dieser Code ist wahr. Aber nach dem Konvertieren von Textdateien in Excel werden die Trennzeichen nicht beibehalten.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Könnten Sie die Textdatei und das gewünschte Ergebnis für mich hochladen?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe das gleiche Problem. Die txt-Dateien befinden sich alle in separaten Blättern und der Code ignoriert den Abstand zwischen den beiden Spalten
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, Des und PB Rama Murty, der folgende Code kann Daten basierend auf Leerzeichen oder Tabulatoren in Spalten aufteilen, während Textdateien in Blätter importiert werden. Sie können es versuchen.

Unter ImportTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dimme ich so lange
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue als Zeichenfolge
Dim xRg als Bereich
Dim xArr
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Wenn xFile = "" Dann
MsgBox "Keine Dateien gefunden", vbInformation, "Kutools für Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xDatei = Dir()
Loop
Legen Sie xToBook = DieseArbeitsmappe fest
On Error Resume Next
Application.ScreenUpdating = False
Wenn xFiles.Count > 0 dann

Für I = 1 bis xFiles.Count
Setze xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close Falsch
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Für xFNum = 1 bis xIntRow
Setze xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Wenn UBound(xArr) > 0 dann
Für xFArr = 0 bis UBound(xArr)
Wenn xArr(xFArr) <> "" Dann
xRg.Wert = xArr(xFArr)
Setze xRg = xRg.Offset(ColumnOffset:=1)
End If
Weiter
End If
Weiter
Weiter
End If
Application.ScreenUpdating = True
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Welche Änderungen sind erforderlich, wenn Daten basierend auf Kommas in Spalten aufgeteilt werden sollen
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Welche Änderungen müssen vorgenommen werden, wenn ich Daten in Spalten basierend auf Kommas zusammenfassen muss?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe dies verwendet und es funktioniert, aber ich möchte, dass alles auf einem Blatt gespeichert wird, da jedes Blatt dieselben Informationen enthält, von denen sie nur Protokolldateien für jeden Tag sind.
Also muss ich die kombinieren
alle Elemente im Ordner auf einem Blatt
Sub-ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dimme ich so lange
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue als Zeichenfolge
Dim xRg als Bereich
Dim xArr
Bei Fehler GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
Legen Sie xSht = ThisWorkbook.ActiveSheet fest
If MsgBox("Löschen Sie das vorhandene Blatt vor dem Importieren?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
Do While xFile <> ""
Setze xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close Falsch
xDatei = Dir
Loop
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "keine txt-Dateien", "Kutools für Excel"
End Sub

und dieser, der Leerzeichen verwendet, um jeder Spalte hinzuzufügen

Unter ImportTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dimme ich so lange
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue als Zeichenfolge
Dim xRg als Bereich
Dim xArr
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Wenn xFile = "" Dann
MsgBox "Keine Dateien gefunden", vbInformation, "Kutools für Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xDatei = Dir()
Loop
Legen Sie xToBook = DieseArbeitsmappe fest
On Error Resume Next
Application.ScreenUpdating = False
Wenn xFiles.Count > 0 dann

Für I = 1 bis xFiles.Count
Setze xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close Falsch
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Für xFNum = 1 bis xIntRow
Setze xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Wenn UBound(xArr) > 0 dann
Für xFArr = 0 bis UBound(xArr)
Wenn xArr(xFArr) <> "" Dann
xRg.Wert = xArr(xFArr)
Setze xRg = xRg.Offset(ColumnOffset:=1)
End If
Weiter
End If
Weiter
Weiter
End If
Application.ScreenUpdating = True
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Was tun, wenn meine Txt-Datei mit Komma getrennt ist?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Sie können die Funktion Suchen und Ersetzen verwenden, um das Komma zuerst durch ein Leerzeichen zu ersetzen, und dann eine der obigen Methoden anwenden, um es in eine Excel-Datei zu konvertieren.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Gibt es keine Möglichkeit das im Code zu ändern? Ich müsste dies mit 130 Dateien tun
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Selbe Frage
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Für diejenigen, die dabei noch Hilfe benötigen, ersetzen Sie xArr = Split(xRg.Text, " ") durch xArr = Split(xRg.Text, ",").
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wenn ich das Modul wie angegeben ausführe, fügt es jede .txt-Datei als neues Blatt hinzu, nicht als neue Zeile zum vorhandenen Blatt. Gibt es eine Möglichkeit, dies als Ausgabe anstelle neuer Blätter für jede TXT-Datei zu erreichen?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wollen Sie alle Textdateien auf einem Blatt kombinieren?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ja das möchte ich auch.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, Davinder, Sie können den folgenden VBA-Code ausprobieren.
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
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Der Code ist sehr hilfreich, es ist der einzige Code, den ich gefunden habe, der TXT-Dateien in großen Mengen abruft. Der Fix, den ich dafür benötige, ist auch das, wonach Joyce und Davinder suchen.
Es dient dazu, die .txt-Dateien zu extrahieren und sie alle untereinander in eine bestimmte Spalte einzufügen, sagen wir Spalte 'N'.

Außerdem müssen Sie wissen, ob es möglich sein wird, eine "Wenn-Bedingung" für die importierten .txt-Dateien wie folgt hinzuzufügen.
Wenn die .txt-Dateien mit dem Buchstaben „A“ beginnen, werden sie auf „Blatt 1“ eingefügt, beginnend mit Zelle „N2“.
und wenn die .txt-Dateien mit dem Buchstaben „B“ beginnen, fügen Sie sie auf „Blatt 2“ ein, beginnend mit Zelle „N2“.
sonst MsgBox als "Nicht erkannter .txt-Dateizweck".

Vielen Dank im Voraus
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe diesen Code für mich gearbeitet, aber ich muss noch etwas daran ändern.

*Ich möchte, dass es auf demselben Blatt eingefügt wird, ohne ein neues Blatt zu öffnen, und es dann kopiert, da es länger dauert.

* Es muss eine Bedingung eingefügt werden, wenn importierte TXT-Dateien in Blatt 1 eingefügt werden, wenn sie mit Buchstabe A beginnen, und in Blatt 2 importiert werden, wenn sie mit Buchstabe B beginnen


Unter testcopy3()
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dim ich als lang
Dim LastRow As Long
Dim Rng As Range
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Wenn xFile = "" Dann
MsgBox "Keine Dateien gefunden", vbInformation, "Kutools für Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xDatei = Dir()
Loop
Bereich ("N2").Auswählen
Legen Sie xToBook = DieseArbeitsmappe fest
Wenn xFiles.Count > 0 dann
Für i = 1 bis xFiles.Count
Setze xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb.Activate
'Textdaten auswählen und kopieren
Bereich (Auswahl, Auswahl.End (xlDown))
Auswahl.Kopieren
xToBook.Activate
ActiveSheet.Paste
Selection.End(xlDown).Offset(1).Select
On Error Resume Next
Bei Fehler GoTo 0
xWb.Close Falsch
Weiter
End If
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Tut mir leid, mir sind die Hände gebunden
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, mein Code läuft, importiert aber nur die erste Datei. Es heißt, es sei ein Methodenfehler beim Kopieren aufgetreten. Der Debugger hebt die folgende Codezeile hervor. Irgendwelche Ideen?


xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe das gleiche Problem, irgendwelche Lösungen gefunden?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hey Kati,
Ich weiß, dass Ihr Kommentar ziemlich alt ist, aber ich hatte das gleiche Problem und habe es folgendermaßen behoben: Das Modul muss in einen Unterordner des aktiven .xlsx-Projekts eingefügt werden. Ich habe den Fehler gemacht, den Code in einen Unterordner meiner PERSONAL.XLSB zu kopieren, wo ich normalerweise meine Makros speichere, und das tut es mit meinen anderen Makros, aber nicht mit diesem.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wie würden Sie die Blätter im VBA-Code löschen, wenn Sie beim erneuten Ausführen des Moduls keine Duplikate wünschen?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Tut mir leid, Harsh, sei nur vorsichtig, um ein wiederholtes Importieren zu vermeiden.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, ich möchte verhindern, dass vorangestellte Nullen in Excel entfernt werden.

Ich habe den folgenden Code ausprobiert, aber er funktioniert nicht


Untertest ()
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dimme ich so lange
Dim j so lange
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Wenn xFile = "" Dann
MsgBox "Keine Dateien gefunden", vbInformation, "Kutools für Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xDatei = Dir()
Loop
Legen Sie xToBook = DieseArbeitsmappe fest
Wenn xFiles.Count > 0 dann
Für I = 1 bis xFiles.Count
Setze xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
ActiveSheet.Cells.NumberFormat = "@" 'Dies dient dazu, Excel im Textformat zu erstellen, bevor die Daten der Textdatei eingefügt werden
xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
Bei Fehler GoTo 0
xWb.Close Falsch
Weiter
End If
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Pooja, Sie können die Funktion Führende Nullen entfernen von Kutools for Excel ausprobieren, um alle führenden Nullen nach dem Importieren aus der Auswahl zu entfernen.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
aber ich möchte nicht entfernen. Ich möchte verhindern, dass vorangestellte Nullen entfernt werden.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wenn Sie die führenden Nullen beibehalten möchten, können Sie sie mit Cell Format als Textformat formatieren.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, wie ändern Sie diesen Code, um *.txt-Dateien in der Reihenfolge einzufügen: 1,2,3,4,5,6,7,8,9,10,11 usw. Derzeit fügt der Code Dateien wie folgt ein:1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX usw. Danke!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Gibt es eine Möglichkeit, Blattnamen nur aus bestimmten Teilen von TXT-Dateinamen zu übernehmen?

Gemäß dem obigen Code wurde der gesamte Blattname übernommen.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Vielen Dank für die Arbeit an Office 2007 Excel
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, mein Code läuft, importiert aber nur die erste Datei. Es heißt, es sei ein Methodenfehler beim Kopieren aufgetreten. Der Debugger hebt die folgende Codezeile hervor. Irgendwelche Ideen?


xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Martinho,
Ich hatte das gleiche Problem und habe es gelöst, indem ich diese Zeile geändert habe:
Legen Sie xToBook = DieseArbeitsmappe fest
zu
Legen Sie xToBook = ActiveWorkbook fest
Vielleicht hilft das.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
0

Ich brauche Ihre Hilfe. Ich habe keine Ahnung, VBA Excel. Ich möchte mehrere Textdateien wie 13000 importieren. Der Name der Textdatei ist beispielsweise derselbe wie die Zelle (c1 = 112, sodass der Name der Textdatei auch 112 lautet), bedeutet, dass die Textdatei 112 ist c112 importieren.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich brauche Ihre Hilfe. Ich habe keine Ahnung, VBA Excel. Ich möchte mehrere Textdateien wie 13000 importieren. Der Name der Textdatei ist beispielsweise derselbe wie die Zelle (c1 = 112, sodass der Name der Textdatei auch 112 lautet), bedeutet, dass die Textdatei 112 ist c112 importieren.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Der Code funktioniert, importiert jedoch jede Textdatei in eine neue Registerkarte in der Arbeitsmappe. Irgendeine Idee, wo im Code dies geändert werden könnte, um die neue Textdatei auf demselben Arbeitsblatt unterhalb der Daten aus der letzten Textdatei zu importieren?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wenn ich im folgenden Code den Ordner angeben möchte, anstatt den Pfad jedes Mal auszuwählen, importiere ich eine Textdatei, was muss geändert werden

VBA-CODE:

Sub-ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
Dim xSht als Arbeitsblatt
Dim xWb als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Bei Fehler GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
Legen Sie xSht = ThisWorkbook.ActiveSheet fest
If MsgBox("Löschen Sie das vorhandene Blatt vor dem Importieren?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
Do While xFile <> ""
Setze xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close Falsch
xDatei = Dir
Loop
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "keine txt-Dateien", "Kutools für Excel"
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, versuchen Sie bitte den folgenden Code
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" ist der Ordnerpfad, aus dem Sie Textdateien importieren können. Bitte ändern Sie ihn nach Bedarf.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, vielen Dank für Ihren wertvollen VBA-Code.
Ich benötige jedoch einen Code für mehrere TXT-Dateien in „einem einzelnen Blatt im Arbeitsblatt, nicht einem einzelnen Blatt für jede TXT-Datei“.
Was soll ich Ihren Code für meinen Zweck bearbeiten?

Vielen Dank,
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, versuchen Sie bitte den folgenden Code
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
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Das funktioniert gut. Aber wenn es importiert, benennt es Blätter mit name.txt um, wie kann man es dazu bringen, nur den Namen zu behalten, ohne dem Blatt die Erweiterung .txt hinzuzufügen?
Bewertet 3.5 aus 5
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ok nvm hat eine Antwort mit Google-Hilfe gefunden.
Zeile ersetzen:
ActiveSheet.Name = xWb.Name
mit:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
würde die letzten 4 Buchstaben aus dem Blattnamen entfernen. Mir effektiv das geben, was ich brauchte. Name ohne .txt
Prost
Bewertet 4 aus 5
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Der folgende Code kann Daten basierend auf Leerzeichen oder Tabulatoren in Spalten aufteilen, während Textdateien in Blätter importiert werden. Aber ich möchte keine separate Registerkarte für jede TXT-Datei, ich möchte sie alle unter einem Blatt. Die Informationen haben für jede Datei das gleiche Format. . Was geändert werden kann, damit dies alles ein einziges Blatt ist, anstatt dass jede importierte Datei eine neue Registerkarte ist. Jede Hilfe wäre willkommen

Unter ImportTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb als Arbeitsmappe
Dim xToBook als Arbeitsmappe
Dim xStrPath als Zeichenfolge
Dim xFileDialog As FileDialog
Dim xFile als Zeichenfolge
Dim xFiles als neue Sammlung
Dimme ich so lange
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue als Zeichenfolge
Dim xRg als Bereich
Dim xArr
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Ordner auswählen [Kutools for Excel]"
Wenn xFileDialog.Show = -1 Dann
xStrPath = xFileDialog.SelectedItems(1)
End If
Wenn xStrPath = "" dann Sub beenden
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Wenn xFile = "" Dann
MsgBox "Keine Dateien gefunden", vbInformation, "Kutools für Excel"
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xDatei = Dir()
Loop
Legen Sie xToBook = DieseArbeitsmappe fest
On Error Resume Next
Application.ScreenUpdating = False
Wenn xFiles.Count > 0 dann

Für I = 1 bis xFiles.Count
Setze xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Kopieren nach:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close Falsch
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Für xFNum = 1 bis xIntRow
Setze xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
Wenn UBound(xArr) > 0 dann
Für xFArr = 0 bis UBound(xArr)
Wenn xArr(xFArr) <> "" Dann
xRg.Wert = xArr(xFArr)
Setze xRg = xRg.Offset(ColumnOffset:=1)
End If
Weiter
End If
Weiter
Weiter
End If
Application.ScreenUpdating = True
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, Daniel, versuchen Sie den folgenden Code, er importiert alle Textdateien in einem Blatt namens Txt.
Beachten Sie Folgendes: Wenn der Textname mit dem Namen des vorhandenen Blatts übereinstimmt, wird die Textdatei möglicherweise nicht importiert.
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


Es sind noch keine Kommentare vorhanden
Hinterlassen Sie Ihre Kommentare
Als Gast posten
×
Bewerte diese Nachricht:
0   Figuren
Vorgeschlagene Standorte

Folgen Sie uns

Copyright © 2009 - www.extendoffice.com. | Alle Rechte vorbehalten. Unterstützt von ExtendOffice. | Sitemap
Microsoft und das Office-Logo sind Marken oder eingetragene Marken der Microsoft Corporation in den USA und / oder anderen Ländern.
Geschützt durch Sectigo SSL