Performance Probleme bei Cells()
10.10.2013 13:23:42
Excelcruncher
ich hoffe mir kann jemand weiterhelfen...
folgendes Problem: ich durchsuche eine große Tabelle in der spalte 4 (D) nach einem Wort. Das ganze funktioniert wunderbar, jedoch dauert das Ganze viel zu lange...nicht weil die Schleifen zu umständlich sind, sondern weil der (hier markierte Bereich) irgendwie lagged.
Das Ganze habe ich mit dem Debugger durchgeschaut und es liegt wirklich nur an dem Bereich, Vorschläge bezüglich der Schleifen sind also nicht wirklich gesucht^^
Das Schreiben der Zellen hatte schonmal wunderbar funktioniert (0 Sekunden für Schreiben von 500 Zeilen), nun aber dauert es für eine Zeile zu schreiben an die 7 Sekunden. Und ich weiß nicht was daran Schuld sein könnte. (Excel-Berechnung ist schon die ganze Zeit auf Manual gestellt)
Was läuft hier falsch? Bin um jede Hilfe dankbar...
Sub doFillCalc()
Dim criteria As String
Dim aimsheet As Worksheet
criteria = "testsuche"
Set aimsheet = Worksheets("zielsheet")
Dim i As Long
Dim month As Byte
Dim criteriacolumn As Integer
Dim rowscolumns As Variant
Dim r As Range
Dim lastcell As Long
Dim database As Worksheet
'takes the criteria to search for
criteriacolumn = 4
lastcell = aimsheet.Cells(rows.Count, 1).End(xlUp).Row
Set database = Worksheets("Masterdata")
Set r = database.Range(database.Cells(2, 2), database.Cells(5, 2))
rowscolumns = r.Value
With database
For month = 1 To 4
If month = 1 Then
For i = 17 To rowscolumns(month, 1)
If criteria = .Cells(i, criteriacolumn) Then
lastcell = lastcell + 1
'hier ist das PROBLEM:
aimsheet.Cells(lastcell, 1) = .Cells(i, 2)
aimsheet.Cells(lastcell, 5) = .Cells(i, 3)
aimsheet.Cells(lastcell, 6) = .Cells(i, 7)
aimsheet.Cells(lastcell, 7) = .Cells(i, 6)
aimsheet.Cells(lastcell, 10) = .Cells(i, 9)
aimsheet.Cells(lastcell, 11) = .Cells(i, 4)
'Ende Problem
End If
Next
End If
Next
End With
MsgBox ("fertig")
End Sub