OpenOffice.info

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

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