txt-Dateien in Excel importieren per Makro
10.08.2016 10:45:19
Andie
ich bin noch ein ziemlicher Anfänger was das Erstellen von Makros in Excel angeht und hoffe hier auf ein bischen Unterstützung.
Zu meinem Problem:
Ich habe mehrere 100 txt-Dateien die ich in Excel importieren möchte. Ich habe mal ein Makro aufgezeichnet was schon fast meine Anforderungen erfüllt.
Die Datei wird importiert, anhand der Trennzeichen die Tabelle erstellt, die nicht benötigten Spalten werden herausgelöscht und die verbleibenden werden benannt. s.u.
Jetzt hätte ich gerne, dass ich ALLE Dateien welche sich in einem Verzeichnis befinden auswählen kann und diese automatisch nach u.a. Schema in eine Exceldatei importiert werden und für jede einzelne Datatei ein eigenes Arbeitsblatt angelegt wird, welches dann mit dem Original Dateinamen benannt wird.
Beim Import muss die *.txt durch Leerzeichen und Anführungszeichen getrennt werden (TextToColumns .Cells(1), Space:=True / TextToColumns .Cells(1), Other:=True, OtherChar:="""")
Wenn der Import durchgeführt ist müssen in jedem Sheet die Spalten (A:B:D:F:G:H:J:K:L:M:N:O:P) gelöscht werden, diese werden nicht benötigt.
Weitehin soll dann noch eine Überschriftenzeile für die 3 verbleibenen Spalten eingefügt werden: A1=Stueck, B1=Preis, C1=Art.Nr.
Anbei mal eine txt und eine xls als Veranschaulichung. Und das aufgezeichnete Makro...
https://www.herber.de/bbs/user/107523.txt
https://www.herber.de/bbs/user/107524.xls
Sub Makro1()
ChDir "D:\test"
Workbooks.OpenText Filename:="D:\test\Test.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=True, OtherChar:="""", FieldInfo:= _
Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1), Array(6, 9), _
Array(7 _
, 9), Array(8, 9), Array(9, 1), Array(10, 9), Array(11, 9), Array(12, 9), Array(13, _
9), Array _
(14, 9), Array(15, 9), Array(16, 9)), TrailingMinusNumbers:=True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Stueckzahl"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Preis"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Art.-Nr."
Range("A1:C1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
ActiveCell.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Find(What:=",", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="(", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub