Hallo an alle,
selbst wenn ich jetzt mit einer unfreundlichen Zuschrift rechnen muß, so möchte ich doch noch eine letzte Bemerkung in diesen Thread stellen. Der in meiner ersten Zuschrift eingefügte Code sollte lediglich die von wagnerpa gestellte Aufgabe erfüllen, den Code in Analogie zu dem VBA-Code der Anfrage zu notieren, mehr nicht.
Darüberhinaus kann aber dieses einfache Beispiel zeigen, daß speziell bei interpretativ arbeitenden Diensten ein sorgfältiges Durchdenken des Programm-Algorithmus überlebenswichtig sein kann. Ich habe mir einmal den Spaß gemacht, einen Laufzeit-Test mit den beiden in diesem Thread abgebildeten Programmstücken sowie mit einem von mir neu geschriebenen Programm-Code (siehe unten) durchzuführen. Es wurde eine Datenmenge von 20000 Werten, davon etwa 6700 verschiedene Werte, mit einer ungünstigen Verteilung angelegt (durchschnittlich kommt also jeder Wert etwa 3mal vor). Bei allen Durchläufen wurde, um gleiche Bedingungen zu erzeugen, OpenOffice neu gestartet. Die Ergebnisse waren insofern erstaunlich, daß der von Karolus gelieferte Code sogar 20 Min. länger benötigte.
Folgende Zeiten wurden gemessen:
Original-VBA-(Excel-)Code: 15 Min. und 35 Sek.
1. Code von Usch 130 Min.
Code von Karolus 150 Min.
2. Code von Usch 1 Min. und 30 Sek.
Ich glaube, der letzte Messwert spricht Bände. Für mich war dieses Beispiel und seine Beschäftigung mit dessen Lösung eine starke Bereicherung in Sachen Erkenntnis. Nun - daß Excel bei vergleichbarem Lösungsverfahren die Nase vorn hat, liegt wohl daran, daß OpenOffice das Programm interpretierend verarbeitet, was aber nicht weiter störend ist. Es zwingt lediglich die Programmierer zu einer effektiven Gestaltung ihrer Algorithmen. Diese Erkenntnis habe ich aus diesem kleinen Beispiel gewonnen. Vielleicht möchte wagnerpa die Sache noch einmal selbst ausprobieren. Wenn sein Datenmaterial sehr umfangreich ist, würde ich es ihm sogar empfehlen. Deshalb unten noch einmal der verbesserte Programm-Code.
Herzliche Grüße
Usch
Code: Alles auswählen
REM ***** BASIC *****
Option Explicit
Public objD As Object
Public objSheet As Object, objZelle As Object
Public objS as Object
Public document as object
Public dispatcher as object
Public args1(0) as new com.sun.star.beans.PropertyValue
Public args2(0) as new com.sun.star.beans.PropertyValue
Public args3(1) as new com.sun.star.beans.PropertyValue
Public Zeil as Integer
Sub Main
objD=ThisComponent
'Application.ScreenUpdating=FALSE:
objD.LockControllers
'Vorbelegungen für Prozeduren "Zaehlen" und "LetzteZelle":
document = objD.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
args1(0).Name = "ToPoint"
args2(0).Name = "StringName"
args3(0).Name = "By"
args3(0).Value = 1
args3(1).Name = "Sel"
args3(1).Value = false
' Aufruf der Algorithmus-Prozedur:
Call ZaehlenUndLoeschen
'Application.ScreenUpdating=TRUE:
objD.UnLockControllers
objD=Nothing
objS=Nothing
objZelle=Nothing
objSheet=Nothing
document=Nothing
dispatcher=Nothing
End Sub
REM *****************************************************
Sub ZaehlenUndLoeschen()
Dim I as Integer, P as Integer, S as String, N as Integer
Call VorSort
objSheet=objD.getCurrentController().ActiveSheet
objZelle = objSheet.getCellRangeByName("A1")
objD.CurrentController.select(objZelle)
Call LetzteZelle
objS=objD.getCurrentSelection()
Zeil=objS.CellAddress.Row
I = 1
S=WL(I-1,0)
While S <> ""
' Realisierung der CountIf-Funktion - Eintragung der Anzahl als Wert in Spalte 2:
Call Zaehlen(I)
objZelle=objSheet.getCellByPosition(1,I-1)
n=objZelle.Value
objZelle.FormulaLocal=N
If N>1 Then
Call ZeilenLoesch(I+1,I+N-1)
EndIf
I = I + 1
S=WL(I-1,0)
Wend
objZelle = objSheet.getCellRangeByName("A1")
objD.CurrentController.select(objZelle)
End Sub
REM *****************************************************
Sub Zaehlen(I as Integer)
args1(0).Value = "$B$" & I
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
args2(0).Value = "=ZÄHLENWENN(A1:A" & Zeil & ";A" & I & ")"
dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args2())
End Sub
REM *****************************************************
Sub LetzteZelle
'Sprung nach erster Spalte in Zeile:
dispatcher.executeDispatch(document, ".uno:GoLeft", "", 0, args3())
'Sprung nach letztem Wert in erster Spalte:
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args3())
'dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args3())
'dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, args3())
End Sub
Sub VorSort
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Sel"
args1(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, args1())
rem ----------------------------------------------------------------------
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args2())
rem ----------------------------------------------------------------------
dim args3(6) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ByRows"
args3(0).Value = true
args3(1).Name = "HasHeader"
args3(1).Value = false
args3(2).Name = "CaseSensitive"
args3(2).Value = false
args3(3).Name = "IncludeAttribs"
args3(3).Value = true
args3(4).Name = "UserDefIndex"
args3(4).Value = 0
args3(5).Name = "Col1"
args3(5).Value = 1
args3(6).Name = "Ascending1"
args3(6).Value = true
dispatcher.executeDispatch(document, ".uno:DataSort", "", 0, args3())
rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Sel"
args4(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, args4())
End Sub
Function WL(Z As Integer, S As Integer) As Variant
' Formel einer Zelle lesen:
WL=objSheet.getCellByPosition(S,Z).FormulaLocal
End Function
sub ZeilenLoesch(ZA as Integer, ZE as Integer)
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$" & ZA & ":$A$" & ZE
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Flags"
args2(0).Value = "R"
dispatcher.executeDispatch(document, ".uno:DeleteCell", "", 0, args2())
end sub