AW: Eine Spalte in mehrere aufteilen.
09.02.2008 23:29:46
fcs
Hallo Berth,
hier eine Lösung, die ich für Datenimport verwende, angepasst an deine Textdatei.
Getestet hab ich nur mit einer kleinen Textdatei, ob 1.000.000 Datenzeilen problemlos verarbeitet werden weiss ich nicht.
Ich hab es so programmiert, dass der Punkt in der Textdatei als Dezimalstelle verarbeitet wird. ggf. muss das noch angepasst werden.
Gruß
Franz
Sub FileImport()
'Zeilenweiser Import eines großen Textfiles in Excel-Tabellenblätter
Dim Zeile As Long, wksNeu As Worksheet, wbNeu As Workbook, BlattNr As Integer
Dim FF As Integer, strText As String, ZeilenBlatt As Long, varDatei, varTest
Dim strNameText As String, Spalte As Integer, var1 As String, var2 As String
varDatei = Application.GetOpenFilename(Filefilter:="Alle (*.*),*.*", _
Title:="Bitte ASCII-Datendatei auswählen", MultiSelect:=False)
If varDatei = False Then GoTo Ende
ZeilenBlatt = Val(InputBox("Anzahl Datenzeilen je Spalte?", _
"ASCII-Daten einlesen", 10000))
If ZeilenBlatt = 0 Then GoTo Ende 'Abbrechen wurde gewählt
Set wbNeu = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksNeu = wbNeu.Worksheets(1)
If ZeilenBlatt > wksNeu.Rows.Count Then
MsgBox "Zeilenzahl pro Blatt muss "" Then wksNeu.Cells(Zeile, Spalte) = CDbl(var1)
If var2 "" Then wksNeu.Cells(Zeile, Spalte + 1) = CDbl(var2)
Else
var2 = Trim(Mid(strText, 9)) 'Wert
var2 = Application.WorksheetFunction.Substitute(var2, ".", ",")
If var2 "" Then wksNeu.Cells(Zeile, Spalte) = CDbl(var2)
End If
Next
'wbNeu.Save 'NeueDatei speichern
'Fortschritt in Statuszeile anzeigen und Zahlenformat der Spalten
If Spalte = 1 Then
Application.StatusBar = (BlattNr - 1) * 254 + ZeilenBlatt _
& " Datensätze eingelesen!"
wksNeu.Columns(1).NumberFormat = "#,##0.0"
wksNeu.Columns(2).NumberFormat = "#,##0.000"
Spalte = Spalte + 2
Else
Application.StatusBar = (BlattNr - 1) * 254 + (Spalte - 1) * ZeilenBlatt _
& " Datensätze eingelesen!"
wksNeu.Columns(Spalte).NumberFormat = "#,##0.000"
Spalte = Spalte + 1
End If
'Weiteres Blatt einfügen, wenn alle Spalten gefüllt sind
If Spalte > wksNeu.Columns.Count Then
Spalte = 1
Set wksNeu = wbNeu.Worksheets.Add(after:=wbNeu.Sheets(strNameText & _
Format(BlattNr, "000")), Type:=xlWorksheet)
BlattNr = BlattNr + 1
wksNeu.Name = strNameText & Format(BlattNr, "000")
End If
Loop
Close #FF
Application.StatusBar = False
Application.ScreenUpdating = True
wbNeu.Save 'NeueDatei speichern
MsgBox "Daten wurden eingelesen!"
Ende:
Set wbNeu = Nothing: Set wksNeu = Nothing
End Sub