Text-Import Code Optimierung möglich?
06.01.2006 09:32:35
Thias
ich habe vor einiger Zeit mit tatkräftiger Unterstützung des Forums einen Code für den automatischen Textimport gebastelt (siehe unten).
Das Makro funktioniert zwar einwandfrei, doch leider dauert der Import einer ca. 500kB großen Textdatei ca. 5 Minuten. Wenn ich die gleiche Datei über "-Daten -externe Daten importieren -Daten importieren" einlese, dauert das nicht mal eine Minute! Wie kommt das?
Mal ins Blaue geraten: Würde es einen Geschwindigkeitsvorteil geben, wenn ich erst nach dem Import der Daten den Punkt durch durch das Komma ersetzen würde, anstatt dies in der Schleife zu realisieren?
Vielleicht liegt es ja aber auch garnicht am einlesen, sondern an den anschließenden Code-Teil, wo ich die Daten noch mal nachbearbeite!
Vielleicht kann mir ja jemand einen Vorschlag machen, wie ich den Code schneller bekomme (sehr gerne auch ausprogrammiert - als Anfänger tue ich mich doch etwas schwer mit der Umsetzung von Tips).
Gruß Thias
------------------------------------------------------------------------------
Sub Rohdaten_Import()
Dim sFile As String, sText As String, sDir As String
Dim arrInput() As String, arrHelp() As String
Dim intI As Integer, intN As Integer, ende As Integer
rohdaten = "Rohdaten"
info = "Info"
'ChDir "Y:\Eigene Dateien\"
'Diese Zeile aktivieren für festen Pfad
sFile = Range("G3").Value
sDir = Range("G5").Value 'Diese Zeile deaktivieren, falls konstanter Pfad festgelegt wird
ChDir sDir 'Diese Zeile deaktivieren, falls konstanter Pfad festgelegt wird
If Dir(sFile) = "" Then
Beep
MsgBox "Datei wurde nicht gefunden!", , "Warnung!"
Exit Sub
End If
Worksheets(rohdaten).Activate
Application.ScreenUpdating = False
Worksheets(rohdaten).Range("A11:AK65536").ClearContents
Open sFile For Binary As #1
sText = Space(LOF(1))
Get #1, , sText
arrInput = Split(sText, vbCrLf)
Close #1
For intI = 0 To UBound(arrInput)
arrHelp = Split(Replace(Replace(arrInput(intI), Chr(9), ";"), ".", ","), ";")
For intN = 0 To UBound(arrHelp)
If IsNumeric(arrHelp(intN)) Then
Cells(intI + 11, intN + 2) = CDbl(arrHelp(intN))
End If
Next intN
Next intI
Cells.NumberFormat = "General" '@ für Text, General für Standard, 0.0 für Zahlen mit einer Nachkommastelle
Application.ScreenUpdating = True
'----------------------------------- Maximum doppeln: Messreihe 1, 0° -------------------------------
ende = Range("N65536").End(xlUp).Row + 1
Range("P11:P12", "Q11:Q12").Copy Range("N" & ende, "O" & ende)
ende = Range("P65535").End(xlUp).Row
Range("P12:Q" & ende).Cut
Range("P11").Select
ActiveSheet.Paste
'----------------------------------- Maximum doppeln: Messreihe 2, 0° -------------------------------
ende = Range("R65536").End(xlUp).Row + 1
Range("T11:T12", "U11:U12").Copy Range("R" & ende, "S" & ende)
ende = Range("T65535").End(xlUp).Row
Range("T12:U" & ende).Cut
Range("T11").Select
ActiveSheet.Paste
'----------------------------------- Maximum doppeln: Messreihe 1, 120° ------------------------------
ende = Range("Z65536").End(xlUp).Row + 1
Range("AB11:AB12", "AC11:AC12").Copy Range("Z" & ende, "AA" & ende)
ende = Range("AB65535").End(xlUp).Row
Range("AB12:AC" & ende).Cut
Range("AB11").Select
ActiveSheet.Paste
'----------------------------------- Maximum doppeln: Messreihe 1, 240° ------------------------------
ende = Range("AH65536").End(xlUp).Row + 1
Range("AJ11:AJ12", "AK11:AK12").Copy Range("AH" & ende, "AI" & ende)
ende = Range("AJ65535").End(xlUp).Row
Range("AJ12:AK" & ende).Cut
Range("AJ11").Select
ActiveSheet.Paste
Range("A1").Select
MsgBox "Roh-Daten wurden importiert!", vbInformation, "Hinweis!"
Worksheets(info).Activate
End Sub