AW: Zellen teilen
10.08.2006 09:08:04
ingUR
Hallo, @EDE,
Soweit ich es erkennen kann, sind eigentlich nur kaumm nennenswerte Änderungen zur Ausführungszeitoptimierung möglich. Jedoch zuvoe die Frage: werden im Tabellenbatt, das verändert wird, Zellenformeln enthalten?
Wenn Zellenformeln enthalten sind und dann kein Ergebnis Auswirkungen auf die Prozedurauswirkung hat, dann solltest folgenden "Rahmen", der den Hinweis von Klaus einbindet, um den Ausführungsteil legen:
Dim OldSetScreenUpdating As Boolean, OldSetCalculation
OldSetScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
OldSetCalculation = Application.Calculation
Application.Calculation = xlCalculationManual
... [hier steht das gesamte Programm, das weder ein Bildschirmm-Update
... noch eine Berechnungsaktualisierung der Zellenformel benötigt]
Application.Calculation = xlCalculationAutomatic
Application.Calculation = OldSetCalculation
Application.ScreenUpdating = True
Application.ScreenUpdating = OldSetScreenUpdating
End Sub
Du hast hier eine Beispieldatei mit 33 Zeilen und drei Spalten vorgestellt. Deine Routinen, die Du zur Ermittlung der Maximalen Zeilen- und Spaltennummer verwendest, kann durch folgenden Ansatz auf ca. ein viertel im Zeitbedarf gesenkt werden, was bei ca. 33000 Zeilen etwa 15 sec. ausmacht (getestet an 10000 Durchläufen), wenn maximal drei Spalten in der Ausgangstabelle enthalten sind - kein wirklicher Zeitgewinn, jedoch bei größerer Spaltenanzahl könnte dieser Zeitgewinn sich vergrößern.
Set ws = Sheets("RohDatenErstellt")
ws.Select
'________________________________________________________________________
' nicht leere Zeilen und Spalten zählen
' vormals: GoSub NichtLeereZählen
'________________________________________________________________________
With ws
intRowEnd = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
Dim r As Long, c As Integer
For r = 1 To intRowEnd
c = .Cells(r, Cells.Columns.Count).End(xlToLeft).Column
If c > intColumnEnd Then intColumnEnd = c
Next r
End With
Eine weitere Optimierung könnte dadurch erreicht werden, dass man vor den IF-Abfragen zur Festellung der Muterposition im String die Abfrage setzt, ob die Länge des Zellenstring überhaubt größer als Null ist, denn dann gann man die Abfragen in dem Zusammenhang mit der Position übergehen. Dies wirkt sich aus, wenn die Datenreihe an ihrem Ende starkt flattern.
Zudem kann ein kleiner Zeitgewinn dadurch entehen, dass man die einzelnen Positions-IF-Fragen durch ELLSE verbindet, denn wenn eine IF-Anweisung zutrifft, brauchen die anderen nicht mehr berücksichtigt zu werden.
Zellenstring = Cells(intRow, intColumn).Value
iLenZS = Len(Zellenstring)
If iLenZS > 0 Then
Pos = InStr(Zellenstring, strPos)
If Pos = 1 And Zellenstring <> strPos Then
Cells(intRow, intColumn).Insert Shift:=xlToRight
intColumn = intColumn + 1
Cells(intRow, intColumn - 1) = Mid(Zellenstring, Pos, iLenP)
Cells(intRow, intColumn) = Right(Zellenstring, iLenZS - Pos - iLenP + 1)
intColumn = intColumn - 1
Else
If Pos > 1 And Pos < iLenZS - iLenP + 1 Then
Cells(intRow, intColumn).Insert Shift:=xlToRight
Cells(intRow, intColumn).Insert Shift:=xlToRight
intColumn = intColumn + 2
Cells(intRow, intColumn - 2) = Left(Zellenstring, Pos - 1)
Cells(intRow, intColumn - 1) = Mid(Zellenstring, Pos, iLenP)
Cells(intRow, intColumn) = Right(Zellenstring, iLenZS - Pos - iLenP + 1)
intColumn = intColumn - 2
Else
If Pos > 1 And Pos = iLenZS - iLenP + 1 Then
Cells(intRow, intColumn).Insert Shift:=xlToRight
intColumn = intColumn + 1
Cells(intRow, intColumn - 1) = Left(Zellenstring, Pos - 1)
Cells(intRow, intColumn) = Mid(Zellenstring, Pos, iLenP)
intColumn = intColumn - 1
End If
End If
End If
End If
Next intColumn
Allerdings sind dies wohl nur Änderungen, die für Dein Beispieldatenblatt keine merkbaren Zeitgewinn bei der Ausführung bringen.
Gruß,
Uwe