Hallo Winfried,
ok machen wir es konkreter:
Sub Filtern
oDatei = Thiscomponent
Dim ii%, ih%, iz%, iZeile%, ib as integer
Dim SortProps(2) As new com.sun.star.beans.PropertyValue
Dim SortFeld(1) As new com.sun.star.table.TableSortField
Dim s4$, sLinie$, s1 as string
s1 = "Hinrichtung"
SortFeld(0).Field = 1
SortFeld(0).IsAscending = True
SortFeld(0).FieldType = com.sun.star.util.SortFieldType.NUMERIC
SortFeld(1).Field = 3
SortFeld(1).IsAscending = True
SortFeld(1).FieldType = com.sun.star.util.SortFieldType.NUMERIC
SortProps(0).Name = "SortFields"
SortProps(0).Value = SortFeld()
SortProps(1).Name = "SortColumns"
SortProps(1).Value = False
SortProps(2).Name = "ContainsHeader"
SortProps(2).Value = false
oBlatt = oDatei.sheets().getByName(s1)
oZelle = oBlatt.getCellByPosition(1,1)
ii= oZelle.value + 2
oBereich = oBlatt.getCellRangeByName("A3:Q"+ii)
oBereich.Sort(SortProps())
kopieren(3, 500, "Muster", "I", "I", s1, "3")
iZeile = 2
' do
ii = izeile
sLinie = Bereich (izeile, s1)
s4 = oDatei.sheets().getByName(s1).getCellByPosition(8, ii).string +
"H"
if odatei.Sheets().hasByName(s4) Then
oBlatt = oDatei.sheets().getByName(s4)
ib = oBlatt.getCellByPosition(1,1).getCellAddress.sheet
oDatei.Sheets.removebyname(s4)
oDatei.Sheets.CopyByName("Muster",s4,ib)
else
oDatei.Sheets.CopyByName("Muster",s4,100)
oBlatt = oDatei.sheets().getByName(s4)
ib = oBlatt.getCellByPosition(1,1).getCellAddress.sheet
end if
kopieren(ii, iZeile, s1, "A", "K", s4, "3")
odatei.store()
verteilung
dia (ib, 1, s4)
dia (ib, 2, s4)
dia (ib, 3, s4)
dia (ib, 4, s4)
' Loop until sLinie = ""
end Sub
function Bereich(id%, s1 as string) as string
Dim iLinie as integer
oBlatt = thiscomponent.sheets().getByName(s1)
iLinie = oBlatt.getCellByPosition(1, id).value
Do
id = id + 1
Loop until oBlatt.getCellByPosition(1, id).value <> iLinie
Bereich = oBlatt.getCellByPosition(8, (id+1)).string
end function
Sub kopieren(ii%, iZeile%, s1$, s2$, s3$, s4$, sz$)
oBlatt = thiscomponent.sheets().getByName(s1)
S3 = (s2 + (ii+1) + ":" + s3 + iZeile)
' msgbox s3
oBereich = oBlatt.getCellRangeByName(s3)
' s4 = oBlatt.getCellByPosition(8, ii).string + s4
' msgbox s4
' msgbox s2+sz
oBlatt = thiscomponent.sheets().getByName(s4)
ozelle = oblatt.getcellRangebyname(s2+sz)
oBlatt.copyRange(ozelle.getCellAddress, oBereich.getRangeAddress)
end sub
Sub Dia (ib%, ii%, s4$)
dim fl as new com.sun.star.awt.Rectangle
dim RangeAddress(3) As New com.sun.star.table.CellRangeAddress
dim RangeAddress1(0) As New com.sun.star.table.CellRangeAddress
dim alle as object, x as object
oBlatt = ThisComponent.Sheets(ib)
alle = oBlatt.Charts
RangeAddress(0).Sheet= ib
RangeAddress(0).StartColumn = 15
RangeAddress(0).EndColumn = 15
RangeAddress(1).Sheet = ib
RangeAddress(2).Sheet = ib
RangeAddress(3).Sheet = ib
fl.Width = 12000
if ii=1 or ii=2 then
fl.Y = 6000
fl.Height = 8500
RangeAddress(0).StartRow = 3
RangeAddress(0).EndRow = 12
RangeAddress(1).StartRow = 3
RangeAddress(1).EndRow = 12
RangeAddress(2).StartRow = 3
RangeAddress(2).EndRow = 12
RangeAddress(3).StartRow = 3
RangeAddress(3).EndRow = 12
end if
if ii=1 or ii=3 then
fl.X = 56000
RangeAddress(1).StartColumn = 20
RangeAddress(1).EndColumn = 20
RangeAddress(2).StartColumn = 22
RangeAddress(2).EndColumn = 22
RangeAddress(3).StartColumn = 24
RangeAddress(3).EndColumn = 24
end if
if ii=2 or ii=4 then
fl.X = 68500
RangeAddress(1).StartColumn = 21
RangeAddress(1).EndColumn = 21
RangeAddress(2).StartColumn = 23
RangeAddress(2).EndColumn = 23
RangeAddress(3).StartColumn = 25
RangeAddress(3).EndColumn = 25
end if
if ii=3 or ii=4 then
fl.Y = 20000
fl.Height = 12500
RangeAddress(0).StartRow = 33
RangeAddress(0).EndRow = 73
RangeAddress(1).StartRow = 33
RangeAddress(1).EndRow = 73
RangeAddress(2).StartRow = 33
RangeAddress(2).EndRow = 73
RangeAddress(3).StartRow = 33
RangeAddress(3).EndRow = 73
end if
alle.removeByname("test"+s4+ii)
alle.addNewByName("test"+s4+ii, fl, RangeAddress(), True, True)
x = alle.getByName("test"+s4+ii).embeddedObject
x.Diagram = x.createInstance("com.sun.star.chart.LineDiagram")
End Sub
sub Verteilung
Dim oZelle2 as object, oZelle3 as object, oZelle4 as object
Dim aa(2) as integer
dim ii%, ij%, ik as integer
dim ergebnis#, zwischen as double
dim zeit as date
zeit = time()
ergebnis = 2000
oDatei = Thiscomponent
odatei.LockControllers
oBlatt = odatei.sheets(25)
oZelle2 = oBlatt.getCellByPosition(28, 8)
oZelle3 = oBlatt.getCellByPosition(29, 8)
oZelle4 = oBlatt.getCellByPosition(29, 6)
oZelle = oBlatt.getCellByPosition(26, 2)
for ii = 1 to 3
select case ii
case 1
oZelle4.value = 90
case 2
ozelle4.value = 95
case 3
ozelle4.value = 99
end select
msgbox ii
for ij = 1 to 20
for ik = ij+1 to 40
oZelle2.value = ij
oZelle3.value = ik
zwischen = oZelle.value
if ergebnis>zwischen then
ergebnis = zwischen
aa(0) = ij
aa(1) = ik
aa(2) = ii
end if
next ik
next ij
next ii
ozelle2.value = aa(0)
ozelle3.value = aa(1)
select case aa(2)
case 1
oZelle4.value = 90
case 2
ozelle4.value = 95
case 3
ozelle4.value = 99
end select
oDatei.UnlockControllers
end Sub
Die letzte Prozedur heißt Verteilung und macht nichts anderes als
systematisch Werte werte in drei Zellen zu schreiben und in der 4. Zelle
das Ergebnis zu vergleichen. Sollte ein besseres erzielt werden, wird
dies und die Parametern im Array gespeichert.
Das ausführen der Funktion alleine bedarf keiner 30 Sekunden.
Wird hingegen die Prozedur wie im Beispiel Filtern aufgerufen, so dauert
die Angelegenheit geschätzte 10 Minuten.
Die Systemauslastung durch den Prozess Staroffice.bin liegt in beiden
Fällen bei 99%
Dieses Verhalten kann ich auch an anderen Stellen beobachten. Meine
Vermutung ist daher das noch irgendwelche Dinge im Speicher liegen, oder
sich sonst irgendwo rumtummeln die eigentlich nicht benötigt sind. Die
würde ich natürlich gerne vor Ausführung der Prozedur rauswerfen.
Ebenfalls schlecht ist wenn die Autosicherung zuschlägt. Dann werden nur
noch leere Diagramme eingefügt, anstelle von welchen mit Inhalt. Auch
das würde ich gerne für die Laufzeit des Makros unterbinden, wenn es
dort Möglichkeiten gibt. Die Autoberechnung kann ich leider nicht
abschalten, da sonst die Makros keine Rückgabewerte bekommen. Vielleicht
kann ich es zeitweise deaktivieren.
Viele Grüße
Jan
Winfried Rohr schrieb:
Hallo Jan:
Wie kann ich umgehen, das so lange für Rechenzeit benötigt wird,
für Funktionen die eigentlich ganz schnell laufen könnten.
Auf eine so allgemein gestellte Frage kann ich Dir nur die
Standardantworten zu Beschleunigung von Makros geben:
* bearbeiten im Hintergrund ( Frame auf HIDDEN setzen )
* ausschalten der AutoBerechnung ( AutomaticCalculation OFF )
* arbeiten mit Bereichen anstelle einzelner Zellen ( RANGE,
DATAARRAY )
Viel Erfolg!
Winfried
---------------------------------------------------------------------
To unsubscribe, e-mail: users-unsubscr...@de.openoffice.org
For additional commands, e-mail: users-h...@de.openoffice.org
