ich habe Probleme mit der Geschwindigkeit beim Importieren der Textdatei in das Tabellenblatt
Wie kann ich dies optimieren?
Danke!
Gruß
Olga
https://www.herber.de/bbs/user/136063.xlsm
Sub Import_txt_alt()
Dim lRow As Long, lCol As Integer
Dim sText As String
Dim cnt As Object
'Textdatei
sFile = ThisWorkbook.Path & "\Angebot.txt"
'Fehlermeldung falls nicht vorhanden
If Dir(sFile) = "" Then
MsgBox "Datei wurde nicht gefunden" & vbLf & "oder verschoben!"
Exit Sub
End If
Application.ScreenUpdating = False
lRow = 1 'erste Zeile
lCol = 9 'erste Spalte
Close
'Txt öffnen und Daten einlesen
Open sFile For Input As #1
With Sheets("Angebot")
Do Until EOF(1)
Line Input #1, sText
Do While InStr(sText, ";")
.Cells(lRow, lCol).Value = Left(sText, InStr(sText, ";") - 1)
sText = Right(sText, Len(sText) - InStr(sText, ";"))
lCol = lCol + 1
Loop
.Cells(lRow, lCol).Value = sText
lRow = lRow + 1
lCol = 9
Loop
Close
'Zahlenwerte formatieren Menge
For Each cnt In .Range(.Cells(2, 10), .Cells(.Rows.Count, 10).End(xlUp))
cnt.Value = fncZahl(sZahl:=cnt.Value, str1000er:=".", strDezimal:=",")
Next
'Zahlenwerte formatieren EP, GP
For Each cnt In .Range(.Cells(2, 13), .Cells(.Rows.Count, 14).End(xlUp))
cnt.Value = fncZahl(sZahl:=cnt.Value, str1000er:=".", _
strDezimal:=",")
Next
End With
Application.ScreenUpdating = True
End Sub
Sub Import_txt()
Dim lRow As Long, lCol As Integer
Dim sText As String
Dim arrData
Dim tStart, tStop
tStart = VBA.Timer
'Textdatei
sFile = ThisWorkbook.Path & "\Angebot.txt"
'Fehlermeldung falls nicht vorhanden
If Dir(sFile) = "" Then
MsgBox "Datei wurde nicht gefunden" & vbLf & "oder verschoben!"
Exit Sub
End If
Close 'alle offenen Dateien schliessen
'Txt öffnen und Datensätze zählen
Open sFile For Input As #1
lRow = 0
Do Until EOF(1)
Line Input #1, sText
lRow = lRow + 1
Loop
Close #1
'Array für die Daten dimensionieren
ReDim arrData(1 To lRow, 1 To 9)
'Txt öffnen und Daten einlesen
Open sFile For Input As #1
lRow = 1 'erste Zeile
lCol = 1 'erste Spalte
Do Until EOF(1)
Line Input #1, sText
Do While InStr(sText, ";")
arrData(lRow, lCol) = Left(sText, InStr(sText, ";") - 1)
sText = Right(sText, Len(sText) - InStr(sText, ";"))
lCol = lCol + 1
Loop
arrData(lRow, lCol) = sText
lRow = lRow + 1
lCol = 1
Loop
Close #1
'Zahlenwerte formatieren
For lCol = 1 To 9
Select Case lCol
Case 2, 5, 6
For lRow = 2 To UBound(arrData, 1)
arrData(lRow, lCol) = fncZahl(sZahl:=arrData(lRow, lCol), str1000er:=".", _
strDezimal:=",")
Next
End Select
Next
'Werte aus Array ins Tabellenblatt übertragen
Application.ScreenUpdating = False
With Sheets("Angebot")
.Cells(1, 9).Resize(UBound(arrData, 1), UBound(arrData, 2)) = arrData
End With
Application.ScreenUpdating = True
tStop = VBA.Timer
MsgBox "Fertig" & vbLf & "Zeit: " & tStop - tStart
End Sub