Importieren mehrerer Dateien in eine einzelne Arbeitsmappe (Microsoft Excel)
Angenommen, Sie haben einen Ordner auf Ihrer Festplatte, der 30 Textdateien enthält, und Sie möchten alle in eine Excel-Arbeitsmappe importieren. Sie möchten, dass jede Textdatei auf einem eigenen Arbeitsblatt in der Arbeitsmappe landet, sodass Sie insgesamt 30 Arbeitsblätter haben.
Eine Möglichkeit, dies zu tun, besteht darin, die gewünschten Arbeitsblätter manuell hinzuzufügen und dann jede der Textdateien einzeln zu importieren. Dies würde, wie Sie sich vorstellen können, schnell langweilig werden. Eine viel bessere Lösung besteht darin, ein Makro für den Import zu verwenden, z. B. das folgende.
Sub CombineTextFiles() Dim FilesToOpen Dim x As Integer Dim wkbAll As Workbook Dim wkbTemp As Workbook Dim sDelimiter As String On Error GoTo ErrHandler Application.ScreenUpdating = False sDelimiter = "|" FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Text Files (.txt), .txt", _ MultiSelect:=True, Title:="Text Files to Open") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "No Files were selected" GoTo ExitHandler End If x = 1 Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x)) wkbTemp.Sheets(1).Copy Set wkbAll = ActiveWorkbook wkbTemp.Close (False) wkbAll.Worksheets(x).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:="|" x = x + 1 While x <= UBound(FilesToOpen) Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x)) With wkbAll wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count) .Worksheets(x).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:=sDelimiter End With x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Set wkbAll = Nothing Set wkbTemp = Nothing Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub
Mit diesem Makro können Sie auswählen, welche Dateien Sie importieren möchten, und dann die Daten aus diesen Dateien auf den separaten Arbeitsblättern in der Arbeitsmappe ablegen. Das Makro geht davon aus, dass die importierten Daten das Pipe-Zeichen (|) als Trennzeichen zwischen Feldern verwenden.
Wenn Sie wissen, dass sich die zu importierenden Dateien immer in einem bestimmten Ordner befinden und dass Sie alle Dateien in diesem Ordner importieren möchten, können Sie das Makro etwas vereinfachen. Im folgenden Beispiel wird davon ausgegangen, dass sich die Dateien im Ordner c: \ temp \ load_excel befinden. Sie können diesen Ordnernamen jedoch ändern, indem Sie einfach die Variable fpath im Makrocode ändern.
Sub LoadPipeDelimitedFiles() Dim idx As Integer Dim fpath As String Dim fname As String idx = 0 fpath = "c:\temp\load_excel\" fname = Dir(fpath & "*.txt") While (Len(fname) > 0) idx = idx + 1 Sheets("Sheet" & idx).Select With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _ & fpath & fname, Destination:=Range("A1")) .Name = "a" & idx .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileOtherDelimiter = "|" .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False fname = Dir End With Wend End Sub
_Hinweis: _
Wenn Sie wissen möchten, wie die auf dieser Seite (oder auf einer anderen Seite der ExcelTips-Websites) beschriebenen Makros verwendet werden, habe ich eine spezielle Seite vorbereitet, die hilfreiche Informationen enthält.
ExcelTips ist Ihre Quelle für kostengünstige Microsoft Excel-Schulungen.
Dieser Tipp (10400) gilt für Microsoft Excel 2007 und 2010. Eine Version dieses Tipps für die ältere Menüoberfläche von Excel finden Sie hier: