Makrooptimierung
08.08.2008 09:24:57
David
Ich bin mal wieder dabei, meine VBA-Kenntnisse auf die Probe zu stellen und zu versuchen, diese zu erweitern.
Ich habe eine aus SAP exportierte Tabelle, die nach bestimmten Vorgaben umgebaut werden muss. Das von mir geschriebene Makro funzt soweit auch zufriedenstellend, nur die Performance ist etwas mager. Mangels Kenntnis von Alternativen verwende ich an mehreren Stellen Schleifen, bei denen die ganze Tabelle abgearbeitet wird. Ich vermute mal, das eine oder andere davon könnte ich auch durch schnellere Befehle ersetzt werden. Dazu wäre ich für konstruktive Vorschläge dankbar. An den Stellen, wo ich Optimierungspotential sehe, habe ich Kommentare eingefügt:
Sub umbauen()
Application.ScreenUpdating = False
Dim last As Integer
last = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
--'Wenn in einer Zeile der ersten Spalte der Text erscheint,
--'soll diese und die folgenden 11 Zeilen gelöscht werden
--'geht das auch einfacher?
For i = 1 To last
If Cells(i, 1) = "ZPP00054" Then
Range(Cells(i, 1), Cells(i + 11, 1)).EntireRow.Delete
End If
Next
Range("s:s").EntireColumn.Delete
Range("a:a").EntireColumn.Delete
Range("F1:K1").Cells.Delete
--'Es sind immer wieder Leerzeilen vorhanden, diese werden hier gesucht und gelöscht
For i = last To 1 Step -1
If Range("F" & i).Value = "" Then Range("F" & i).EntireRow.Delete
Next
Dim lastused As Integer
lastused = ActiveSheet.Cells(Rows.Count, 10).End(xlUp).Row
--'in den ersten 5 Spalten steht in unregelmäßigen Abständen ein Text/Wert.
--'in den Zeilen, in denen dieser nicht steht, soll der darüber liegende Text/Wert
--'eingetragen werden - kann man das auch kürzer schreiben?
For i = 2 To lastused
For j = 1 To 5
If Cells(i, j) = "" Then
Cells(i, j) = Cells(i, j).Offset(-1, 0)
End If
Next
Next
--'ab hier wird sicher nichts mehr zu optimieren sein
Range("B:B").NumberFormat = "DD.MM.YYYY"
Range("A1").EntireRow.Insert
Cells(1, 1) = "order"
Cells(1, 11) = "%over/under usg"
Range("1:1").Font.Bold = True
Range("A1:K" & lastused).AutoFilter
Range("A:K").Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Vielen Dank schon mal.
Gruß
David