AW: Textinhalt aus Txt.Datei in Excel bearbeiten (vba)
19.02.2015 11:21:04
fcs
Hallo Heinz,
leider hat deine Textdatei ein paar Eigenheiten (Leerzeichen trannt nicht immer die Spalte, Datensatz-Ende-Zeichen ist etwas ungewöhnlich), so dass die ursprünglich von mir angedachte Lösung nicht funktioniert.
Gruß
Franz
'Code in einem allgemeinen Modul
Sub Import_Textdatei_Heinz()
' Import_Textdatei_Heinz Makro
Dim varDatei As Variant
Dim Zeile1 As Long, Zeile2 As Long
Dim wkbTxt As Workbook, wksTxt As Worksheet, ZeileTxt As Long, SpalteTxt As Long
Dim wkb As Workbook, wks As Worksheet, Zeile As Long, Spalte As Long
Dim varWerte(1 To 4) As Variant
'Textdatei im Dateidialog auswählen
varDatei = Application.GetOpenFilename(Filefilter:="Textdatei (*.txt),*.txt", _
Title:="Bitte aufzubereitende Textdatei auswählen")
If varDatei False Then
Application.ScreenUpdating = False
'Textdatei in Excel öffnen und Daten für Spalte 4 auf Spalten aufteilen
Workbooks.OpenText Filename:=varDatei, Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), _
Array(2, 9), Array(3, 2), Array(21, 9), Array(22, 2), Array(25, 9), Array(26, 2)), _
TrailingMinusNumbers:=True, Local:=True
Set wkbTxt = ActiveWorkbook
Set wksTxt = wkbTxt.Worksheets(1)
With wksTxt
.Columns("A:C").EntireColumn.AutoFit
.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Zeilenbereich mit Daten in Spalte E
If IsEmpty(.Range("E1")) Then
Zeile1 = .Range("E1").End(xlDown).Row
Else
Zeile1 = 1
End If
Zeile2 = .Cells(.Rows.Count, 5).End(xlUp).Row
'Inhalte für Spalte 4 am Leerzeichen splitten
.Range(.Cells(Zeile1, 5), .Cells(Zeile2, 5)).TextToColumns _
Destination:=.Cells(Zeile1, 5), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), _
Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
End With
'neue Mappe anlegen für aufbereitete Daten aus Textdatei - Zieltabelle für die _
aufbereiteten Daten kann natürlich auch anders festgelegt werden.
Set wkb = Application.Workbooks.Add(Template:=xlWBATWorksheet)
Set wks = wkb.Worksheets(1)
Zeile = 1
'Spaltentitel eintragen - ggf. anpassen
wks.Cells(Zeile, 1) = "Wert1"
wks.Cells(Zeile, 2) = "Wert2"
wks.Cells(Zeile, 3) = "Wert3"
wks.Cells(Zeile, 4) = "Wert4"
'aufbereitete Textdaten in neue Datei übertragen
With wksTxt
For ZeileTxt = Zeile1 To Zeile2
'Werte aus den ersten 3 Spalten in Datenfeld einlesen
For Spalte = 1 To 3
varWerte(Spalte) = .Cells(ZeileTxt, Spalte)
Next Spalte
'in Zeile Spalten mit den Werten für die 4. Spalte abarbeiten
For SpalteTxt = 5 To .Cells(ZeileTxt, .Columns.Count).End(xlToLeft).Column
'Wert für 4. Spalte in Datenfeld einlesen
varWerte(4) = .Cells(ZeileTxt, SpalteTxt)
'Daten in nächste Zeile des Excelblatt eintragen
Zeile = Zeile + 1
For Spalte = 1 To 4
wks.Cells(Zeile, Spalte) = varWerte(Spalte)
Next Spalte
Next SpalteTxt
Next ZeileTxt
End With
'Textdatei ohne speichern wieder schliessen
wkbTxt.Close savechanges:=False
'Ausgabeblatt formatieren
With wks
.Columns.AutoFit
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True
End If
End Sub