Gruppe
Extern
Problem
Es soll zuerst ein Textdatei mit 250.000 Zeilen angelegt werden, die dann in mehrere Arbeitsblätter zu importieren ist.
StandardModule: Modul1
Sub Txt2Sheets()
Dim lRow As Long
Dim iWks As Integer
Application.ScreenUpdating = False
FileCopy "c:\test.txt", "c:\test1.txt"
For lRow = 1 To Fix(250000 / 65536) + 1
iWks = iWks + 1
Application.StatusBar = "Importiere " & iWks & ". Blatt..."
Workbooks.OpenText _
Filename:="c:\Test1.txt", _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
With ThisWorkbook
ActiveSheet.Move after:=.Worksheets(.Worksheets.Count)
ActiveSheet.Name = "Blatt" & iWks
End With
Call DeleteText
Next lRow
Kill "c:\test1.txt"
Application.StatusBar = False
Application.ScreenUpdating = True
Worksheets("Tabelle1").Select
MsgBox "Job erledigt!"
End Sub
Private Sub DeleteText()
Dim lCounter As Long
Dim sTxt As String
Open "c:\test1.txt" For Input As #1
Open "c:\test2.txt" For Output As #2
Do Until EOF(1)
lCounter = lCounter + 1
Line Input #1, sTxt
If lCounter > 65536 Then
Print #2, sTxt
End If
Loop
Close
Kill "c:\test1.txt"
Name "c:\test2.txt" As "c:\test1.txt"
End Sub
Sub CreateText()
Dim lCounter As Long
Open "c:\test.txt" For Output As #1
For lCounter = 1 To 250000
If lCounter Mod 10000 = 0 Then
Application.StatusBar = "Lege Zeile " & lCounter & " an..."
End If
Print #1, "Zeile " & lCounter
Next lCounter
Close
Application.StatusBar = False
MsgBox "Textdatei wurde angelegt!"
End Sub