Dubletten entfernen

[Stephan]

Du hast vergessen die Vergleichzeile zu löschen falls eine Dublette gefunden wird. Folgendes sollte gehen:

Code: Alles auswählen

Sub Dubletten_finden
   odoc=thiscomponent
   oSheet = oDoc.CurrentController.getActiveSheet()
   myrows=oSheet.getrows
   oCellCursor = oSheet.createCursor()
   oCellCursor.GotoEndOfUsedArea(True)
   letzte_Zeile = oCellCursor.getRangeAddress.EndRow
   k = 0
   for i = 0 to letzte_Zeile
   gefunden = 0 
   text1 = osheet.getcellbyposition(0,i).string
   for j = i + 1 to letzte_Zeile
   text2 =osheet.getcellbyposition(0,j).string
   if   text1 = text2 then
   myrows.removebyindex(j,1)
   letzte_Zeile = oCellCursor.getRangeAddress.EndRow
   j = j - 1
   k = k + 1
   gefunden = 1
   end if   
   next j
   If gefunden = 1 Then
     myrows.removebyindex(i,1)
     gefunden = 0
     letzte_Zeile = oCellCursor.getRangeAddress.EndRow
   End If
   next i
   msgbox "Der Vorgang ist abgeschlossen"& CHR(13)& "Es wurden " & k & " Dubletten gefunden",64, "Dubletten finden"
End Sub

ist aber nicht weiter auf Fehlerfreiheit getestet, weil ich dazu auch keinen Trick habe sondern das einfach testen müßte was Du genausogut tun kannst.


Gruß
Stephan

[DPunch]

Aloha

Keiner eine Idee?

Deutlich schneller und unkomplizierter als das Iterieren über alle Zellen sollte das hier sein:

Code: Alles auswählen

	oDoc = thisComponent
	oDoc.lockControllers
	oSheet = oDoc.CurrentController.ActiveSheet
	oCursor = oSheet.createCursor
	oCursor.gotoEndOfUsedArea(False)
	nLastRow = oCursor.RangeAddress.EndRow
	ReplaceDesc = oSheet.createReplaceDescriptor
	ReplaceDesc.SearchWords = True
	ReplaceDesc.replaceString = ""
	oBaseRange = oSheet.getCellRangeByPosition(0,0,0,nLastRow)
	For i=0 To nLastRow-1
		ReplaceDesc.SearchString = oSheet.getCellByPosition(0,i).String	
		oRange = oSheet.getCellRangeByPosition(0,i+1,0,nLastRow)
		oResult = oRange.findAll(ReplaceDesc)
		If NOT isNull(oResult) Then
			oBaseRange.replaceAll(ReplaceDesc)
		End If
	Next i
	aEmpty = oBaseRange.queryEmptyCells.RangeAddresses
	For k=UBound(aEmpty) To 0 Step -1
		oSheet.removeRange(aEmpty(k),1)
	Next k	
	oDoc.unlockControllers

[Stephan]

Deutlich schneller und unkomplizierter als das Iterieren über alle Zellen sollte das hier sein

Schneller mit Sicherheit, ich denke bis Faktor 10 ohne es probiert zu haben, 'unkompliziert' weiß ich nicht, denn gerade für Anfänger setzt ja die implementierte Suchroutine Einiges an Kenntnissen vorraus.

Die von Stephan funktioniert leider nicht.

Dann wäre ich sehr dankbar gewesen für einen konkreten Hinweis welcher Fehler erzeugt wird, andere Nachleser des Threads sicher ebenfalls, denn falsche Lösungsvorschläge nützen niemandem und irritieren Einsteiger nur.



Gruß
Stephan

[sven-my]

Hallo DPunch,

ja, kann ich bestätigen reichlich schneller !

Klar, gefragt war, alle Doubletten zu entfernen : also 1,2,2,3 -> 1,3

jetzt rätsel ich seit Stunden über die Möglichkeit, das Makro so umzubauen, daß wirklivch nur die Doubletten erntfernt werden,

also so : 1,2,2,3 -> 1,2,3

nur reicht mein BASIC-Wissen irgenwie nicht aus. Kannst Du da weiterhelfen ?

gruß
sven-my

[sven-my]

hallo xenadar,

den Beitrag hatte ich gestern gefunden, und auch das Makro eingesetzt - bis zu einer Listenlänge von ca. 100 Zeilen auch noch erträglich, aber gestern hatte ich eine Liste mit 536 Einträgen.

Ich rate keinem das nachzumachen - soviel Kaffee ist meist nicht im Haus.


gruß
sven-my

[DPunch]

Aloha

nur reicht mein BASIC-Wissen irgenwie nicht aus. Kannst Du da weiterhelfen ?

Letztendlich musst Du nur den Teil

Code: Alles auswählen

      If NOT isNull(oResult) Then
         oBaseRange.replaceAll(ReplaceDesc)
      End If

ersetzen durch

Code: Alles auswählen

      If NOT isNull(oResult) Then
         oRange.replaceAll(ReplaceDesc)
      End If

oBaseRange ist der komplette zu betrachtende Abschnitt (z.B. A1:A10), während oRange der Abschnitt hinter der aktuell zu untersuchenden Zahl/Zeichenkette ist (steht in A1 eine 5, wäre oRange also A2:A10). Ersetzt Du nur in oRange, bleibt die gerade betrachtete Zahl/Zeichenkette dementsprechend stehen.

[sven-my]

Hallo DPunch,

herzlichen Dank - klappt prima !

jetzt werde ich es mal mit der elendlangen Liste probieren.


gruß
sven-my

[sven-my]

Hallo Stephan,

mit Faktor 10 hast Du Dich aber um einiges vertan ! Hänge an Deine Schätzung ohne schlechtes Gewissen mindestens drei Nullen dran.

Meine 582 - Zeilen-Liste war in ca. 2sec bereinigt, mir dem anderen Code hat es gestern rund 50min gedauerd (so genau hatte ich nicht auf die Uhr geschaut, hab' den Rechner laufen lassen, und Fern gesehen)


gruß
sven-my

[Stephan]

mit Faktor 10 hast Du Dich aber um einiges vertan !

Danke für den Hinweis.




Gruß
Stephan

[sven-my]

Hallo an alle,

neben der Geschwindigkeit, gibt es einen weiteren Unterschied, der nicht ganz außer acht zu lassen ist:

der hier zuerst veröffentlichte Code entfernt die ganze ZEILE, der schnelle Code nur die ZELLE.

Damit kann ich aber gut leben, ich habe einfach folgende Zeile geändert:

Code: Alles auswählen

ReplaceDesc.replaceString = "zzz doublette" rem eigentlich ""

dann sortiere ich die Liste, und lösche dann das ganze Paket an Doubletten-Zeilen "von Hand".

gruß
sven-my

[DPunch]

Aloha

Damit kann ich aber gut leben, ich habe einfach folgende Zeile geändert

Du kannst auch ganz einfach folgende Codezeile ändern

Code: Alles auswählen

oSheet.removeRange(aEmpty(k),1)

in

Code: Alles auswählen

oSheet.removeRange(aEmpty(k),3)

wenn Du die kompletten Zeilen rausgelöscht haben willst.

[sven-my]

Hallo DPunch,

Danke Dir.

Allerdings verlangsamt die Löschung der ganzen Zeile das Ganze doch erheblich.
Für eine 70 - Zeilen-Tabelle (35 Doubletten) dauerd es bei Zellenlöschung ca. 1sec (wahrscheinlich weniger) bei Zeilenlöschung hat mein Rechner rund sechs Minuten gebraucht.

Ich nehme an, daß es bei realistischer Doublettenanzahl (ca. 3% Doublettenanteil) schneller geht.

gruß
sven-my

[DPunch]

Aloha

Das ist seltsam - ich hab gerade beide Methoden mal verglichen - und sie dauern exakt gleich lange, nämlich rund 30 ms
(bei einem Tabellenblatt, das im gesamten Bereich A1:BU1000 mit Zahlen gefüllt ist und aus dem 281 Dupletten-Zeilen rausgelöscht werden).

Gesamtdauer:
10094 Ticks (~10,094 Sekunden)
davon für Suchen&Ersetzen:
10063 Ticks (~10,063 Sekunden)
Zeilen löschen bzw Zellen löschen:
31 Ticks (~0,031 Sekunden)

Wenn man Leerstrings aus der Suche ausschliesst, kann man beim Suchen&Ersetzen nochmal rund 20% gewinnen, das Löschen der Zeilen oder Zellen passiert konstant schnell.

[sven-my]

Hallo Dpunch,

so, ich habe es jetzt mal mit einem neuen Tabellendokument versucht --- bekomme wohl ähnliche Werte heraus, wie Du.

Tabelle A1 - J238, enthalten 120 Doubletten

Zellen löschen : 3,473 E-5 sec
Zeilen löschen : 2,314 E-5 sec

Code: Alles auswählen

       oBaseRange = oSheet.getCellRangeByPosition(0,0,0,nLastRow)
aZ = now
       For i=0 To nLastRow-1

Code: Alles auswählen

       oDoc.unlockControllers
eZ = now
vZ = eZ - aZ
msgbox vZ

Es ist mir ein Rätsel, weshalb das vorhin so lange gedauerd hat.

Vorhin hatte ich einfach eine neues Tabellenblatt in das in Arbeit gewesene Dokument eingefügt, um den neuen Code auszuprobieren.

Falls ich was rausfinde, woran es gelegen haben könnte melde ich mich wieder.

gruß
sven-my

[sven-my]

Hallo DPunch,

heute habe ich nochmal diese Tabelle genommen:

Tabelle A1 - J238, enthalten 120 Doubletten

Jetzt dauerte es fürs Zeilenlöschen 115 E-5 sec.

Die Zeitnahme habe ich etwas verändert :

Code: Alles auswählen

       oDoc = thisComponent
aZ = now

Code: Alles auswählen

       oDoc.unlockControllers
eZ = now
vZ = eZ - aZ
msgbox "fertig nach " & vZ &" sec"

UND eine neues Phänomen ist aufgetreten : starte ich das Makro mehrmals hintereinander, wird die Anzeige nicht mehr aktualisiert; erst wenn ich auf ein anderes Tabellenblatt gehe, und dann wieder zurück, habe ich die aktuelle Ansicht.

Da nach dem ersten Durchlauf noch alles in Ordnung ist, stört mich das nicht weiter. Ich werde mir nochmal die Tabelle vornehmen, bei der es lange gedauerd hat.

gruß
sven-my