Doppelte einträge Löschen

[Eddy]

Hallo Nadine Paneutz,

benutze die Suchfunktion dieses Forums mit den Worten Deiner "Problembeschreibung" und lese den ersten gefundenen Beitrag.

[clag]

Hallo Nadine Paneutz,

da gibt es verschiedene Möglichkeiten ........

eine komfortable und schnelle, ist die Filterfunktion von Calc
vorausgesetzt in den Optionen ist die Anzeige von Duplikaten unterdrücken angewählt,
wenn du dann noch die Ausgabe in einen anderen Bereich wählst,
bekommst du dort eine neue von Duplikaten befreite Liste, die du ggf kopieren kannst !?

[clag]

Hallo Nadine,

warum gleich die "grosse Speziale"

mit dem Standard Filter hast du das mit 5 Mausklicks erledigt

ok, ich gebe zu war vielleicht etwas ungenau weil unter Standard heißen die Optionen auch manchmal Zuätze

[clag]

Hi,

also eigentlich hatte ich damit noch nie Probleme

willst du nur die eine Spalte von Duplikaten befreien oder sind möglicherweise noch andere Spalten mit markiert ?

markiere nur die eine Spalte und ruf den StandardFilter auf, Bereich nicht erweitern falls danach gefragt werden sollte!

[clag]

Hallo,

ja genauso wähle doch noch einen Ausgabebereich
dazu brauchst du nur den Cursor in das Feld Ausgabebereich setzen und dann eine Zelle anklicken
dann bekommst du dort beginnend eine saubere Liste ausgegeben !

vorher musst du aber alle Zeilen wieder einblenden die durch die Filteraktion ohne Ausgabe ausgeblendet wurden,
sonst könnte Calc da stolpern

duplikate_löschen1.png (15.96 KiB) 3654 mal betrachtet

[clag]

Hi,

vielleicht sind die Einträge nicht ok?
aber da habe ich keine Idee was ....

wenn du keine Bedenken hast, kannst du die Datei hier hochladen,
und wir schauen mal gemeinsam woran es liegen könnte ?

[balu]

Hallo Nadine,

versuchs doch mal mit diesen Einstellungen.

Filter0.jpg (81.16 KiB) 3642 mal betrachtet

Gruß
balu

[turtle47]

Hi Nadine,

[Edit] Blödsinn gelöscht[/Edit]

Versuche mal folgendes Makro:

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
		for i = 0 to letzte_Zeile
		text1 = osheet.getcellbyposition(0,i).string 'Durchsucht Spalte A (Index 0 (Null))
		if text1 = "" then
		goto weiter
		end if
			for j = i + 1 to letzte_Zeile
			text2 = osheet.getcellbyposition(0,j).string 'Durchsucht Spalte A (Index 0 (Null))
				if   text1 = text2 then
				osheet.getcellbyposition(0,j).string = ""
				end if   
			next j
			weiter:
		next i
	msgbox "Fertig",64, "Dubletten finden"
End Sub

Das funktioniert leider nur bis Zeile 17834

Wenn die Liste so lang ist, dann kann das Überprüfen schon eine gaaaanze Weile dauern.

Versuche es mal an einer Dateikopie mit ein paar Zeilen damit Du ein Gefühl für die benötigte Zeit bekommst.

Jürgen

[bst]

Morgen,

mal ein Versuch. Auch wenn die Collections in OOo Basic wohl nicht so schnell sein dürften wie ein Hash (oder auch ein Dictionary-Object in VBScript) sollte das doch deutlich schneller sein,

Zu Collections siehe: http://www.oooforum.org/forum/viewtopic.phtml?p=387376

Nachtrag: Code um formatiert, d.h. Tabs entfernt ?

cu, Bernd
--

Code: Alles auswählen

REM  *****  BasIC  *****
Option Explicit

Sub DelDouble
   Dim oSheet as Object, oCellCursor as Object, oCellRange as Object
   Dim arData as Variant, i as Long, iLastRow as Long
   Dim col as New Collection, strKey as String
   Dim t as Long

   t = Timer   

   oSheet = ThisComponent.CurrentController.getActiveSheet()
   oCellCursor = oSheet.createCursor()
   oCellCursor.GotoEndOfUsedArea(True)
   iLastRow = oCellCursor.getRangeAddress.EndRow

   oCellRange = oSheet.getCellRangeByPosition(0,0,0,iLastRow)
   arData = oCellRange.getDataArray
   for i = 0 to iLastRow
      strKey = Trim(arData(i)(0))
      if len(strKey) > 0 Then
         if ColItemExists(col, strKey) Then
            arData(i)(0) = ""
         else
            col.Add 0, strKey
         endif
      endif
   next
   oCellRange.setDataArray   arData

   print Timer - t
End Sub

Function ColItemExists(ByVal col as Collection, ByVal strKey as String) as Boolean
   On Error Resume Next
   ColItemExists = Len(col(strKey)) > 0
End Function