VBA-script extrem langsam
23.10.2015 01:02:36
Stephan
ich habe ein VBA-Script, welches mir CSV-Dateien aus einem Ordner in meinen Excel-Sheet importiert. Klappt soweit auch alles. Problem ist nur, wenn ich das Makro auf ein Tabellenblatt loslasse, welches diese Daten dann in anderen Tabellenblättern verarbeitet geht gar nichts mehr. Wenn ich ein neues Blatt anfüge und dort die Dateien importiere geht es, auch wenn es etwas langsam ist.
Hier mal ein Link zum Excel-file. Es ist größer als 300kb, deshalb ein Dropbox-Link:
https://www.dropbox.com/s/p1axloj7ubl447j/Probe_2_Spektrenauswertung_normiert.xlsm?dl=0
Und hier das Makro:
Sub import_text()
Dim fd As FileDialog
Dim strFolder As String
Dim strName As String
Dim intCol As Integer
Dim rngCell As Range
Dim ws As Worksheet
Dim varArr As Variant
Dim i As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets(1)
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show -1 Then Exit Sub
strFolder = fd.SelectedItems(1) & "\"
strName = Dir(strFolder & "*.csv")
Set rngCell = ws.Cells(2, Columns.Count)
While Len(strName) > 0
If IsEmpty(rngCell.End(xlToLeft).Value) Then
intCol = 1
Else:
intCol = rngCell.End(xlToLeft).Column + 1
End If
Workbooks.OpenText Filename:=strFolder & strName, Local:=True
ActiveSheet.UsedRange.Copy ws.Cells(2, intCol)
ws.Cells(1, intCol).Value = strName
ActiveWorkbook.Close SaveChanges:=False
strName = Dir
For i = 2 To ws.Cells(Rows.Count, intCol).End(xlUp).Row
varArr = Split(ws.Cells(i, intCol).Value, " ")
ws.Cells(i, intCol).Value = varArr(0)
ws.Cells(i, intCol + 1).Value = varArr(1)
Next i
Wend
Set ws = Nothing
Set fd = Nothing
Set rngCell = Nothing
Application.ScreenUpdating = True
End Sub
Vielen Dank schonmal für die Hilfe.
Viele Grüße!