REM  *****  BASIC  *****
REM Quellen: viele viele Internetseiten, besonders zu erwähnen:
REM Tabellenvergleich: http://de.openoffice.info/viewtopic.php?p=28758&sid=965a5a12aaf66b3590c55a05d224c9e7#p28758 von User "kannenklaus"
REM RangeSelection: https://forum.openoffice.org/en/forum/viewtopic.php?p=365582&sid=bfd72575bb8566a9fce7ef91d5c36d15#p365582 Datei von User "FJCC"
REM Sortieren: Dokument "OpenOffice.org Macros Explained.odt" von http://www.pitonyak.org/oo.php von "Andrew Pitonyak", Kapitel 5.4.13


sub A_Zeilen_angleichen
dim eins as string
dim zwei as string
dim speins as integer
dim spzwei as integer
dim pos as integer
dim temp as string
if MsgBox ("Sortiert die Tabellen automatisch jeweils nach Index-Spalte. WEITER?",1)= 2 then
exit sub
end if
  MsgBox ("Index-Spalte in erster Tabelle durch Klick auf Zelle auswählen")
  eins = Mache_Auswahl
  pos = instr(eins,":")
  temp = right(eins, len(eins)-pos)
  speins = CInt(temp)
  eins = left(eins, pos-1)
  MsgBox ("Index-Spalte in zweiter Tabelle durch Klick auf Zelle auswählen")
  zwei = Mache_Auswahl
  pos = instr(zwei,":")
  temp = right(zwei, len(zwei)-pos)
  spzwei = CInt(temp)
  zwei = left(zwei, pos-1)
  if (eins <> zwei) then
    Tue_Tabelle_sortieren(eins, speins)
    Tue_Tabelle_sortieren(Zwei, spzwei)
    Tue_Zeilen_angleichen(eins, zwei, speins, spzwei)
  else
    MsgBox ("Unterschiedliche Tabellenblätter im selben Dokument nötig")
  end if
  MsgBox ("FERTIG")
end sub


sub B_Tabellen_vergleichen
dim eins as string
dim zwei as string
dim speins as integer
dim spzwei as integer
dim pos as integer
dim temp as string

if MsgBox ("Erste Tabelle durch Klick auf Zelle auswählen, wird Index-Spalte falls sortiert werden soll. WEITER?",1)= 2 then
exit sub
else
  eins = Mache_Auswahl
  pos = instr(eins,":")
  temp = right(eins, len(eins)-pos)
  speins = CInt(temp)
  eins = left(eins, pos-1)
  MsgBox ("Zweite Tabelle durch Klick auf Zelle auswählen, wird Index-Spalte falls sortiert werden soll.")
  zwei = Mache_Auswahl
  pos = instr(zwei,":")
  temp = right(zwei, len(zwei)-pos)
  spzwei = CInt(temp)
  zwei = left(zwei, pos-1)
  if (eins <> zwei) then
    if MsgBox ("Jeweils nach Index-Spalte sortieren? (dumm bei Leerzeilen)",1)=1 then
      Tue_Tabelle_sortieren(eins, speins)
      Tue_Tabelle_sortieren(Zwei, spzwei)
    end if
    Tue_Tabellen_vergleichen(eins, zwei)
  else
    MsgBox ("Unterschiedliche Tabellenblätter im selben Dokument nötig")
  end if
  MsgBox ("FERTIG. Markierungen sind nur in Tabelle 2.")
end if  
end sub

Sub Tue_Tabellen_Vergleichen(eins as String, zwei as String)
   '--Variablen für den Tabellenvergleich
   Dim oDoc as Object
   Dim oDocB as Object
   Dim oShFehler as Object
   Dim oAllSheetsA as Object
   Dim oAllSheetsB as Object
   Dim oSh1 as Object
   Dim oSh2 as Object
   Dim oCurSp1 as Object
   Dim oCurZe1 as Object
   Dim oCurSp2 as Object
   Dim oCurZe2 as Object
   Dim oCell1 as Object
   Dim oCell2 as Object
   Dim oCellDoku1 as Object
   Dim oCellDoku2 as Object
   Dim oView as Object 'für den View
   Dim oCellInfo as Object
   Dim oCellUeber as Object
   Dim oRange1 as Object
   Dim oRange2 as Object
   Dim oSpalte as Object 'Spaltenüberschrift der Reportabelle
   Dim intMaxZe as Integer
   Dim intMaxSp as Integer 'Zähler für die max. Zeilen- bzw. Spaltenzahl
   Dim intSp as Integer
   Dim intZe as Integer 'Zähler für Spalten- und Zeilenanfang
   Dim geaendert as Integer

' ### hier erzeugt er die Datei-Variable
   oDoc = ThisComponent
   oAllSheets = oDoc.Sheets
   oSh1 = oAllSheets.getByName(eins)
   oSh2 = oAllSheets.getByName(zwei)

   oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1
   oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1
   oCurSp2 = oSh2.createCursor 'Spaltenzähler für Blatt 2
   oCurZe2 = oSh2.createCursor   'Zeilenzähler für Blatt 2
   
'--Cursor für das 1. Blatt erzeugen
   oCurSp1.gotoEndofUsedArea(true)
   oCurSp1.Columns.Count
   oCurZe1.gotoEndOfUsedArea(True)
   oCurZe1.Rows.Count

'--Cursor für das 2. Blatt erzeugen
   oCurSp2.gotoEndofUsedArea(true)
   oCurSp2.Columns.Count
   oCurZe2.gotoEndOfUsedArea(True)
   oCurZe2.Rows.Count
  
'--maximale Zeilenzahl ermitteln
   If oCurSp1.Columns.Count > oCurSp2.Columns.Count then
      intMaxSp = oCurSp1.Columns.Count
'      msgbox(intMaxSp)
   Else
      intMaxSp = oCurSp2.Columns.Count   
'      msgbox(intMaxSp)
   End if

'--maximale Zeilenenzahl ermitteln
   If oCurZe1.Rows.Count > oCurZe2.Rows.Count then
      intMaxZe = oCurZe1.Rows.Count
   Else
      intMaxZe = oCurZe2.Rows.Count
   End if

'--Tabellenvergleich durchführen
' Zwei For/next-Schleifen, um Zellen der beiden Tabellenblätter vergleichen
   geaendert = 0
   For intSp = 0 to intMaxSp-1 '-1, da EndofArea zur nächsten nicht benutzten Spalte geht
      For intZe = 0 to intMaxZe-1 '-1, da EndofUsedArea zur nächsten nicht benutzten Zeile geht
         oCell1 = oSh1.getCellByPosition(intSp,intZe)
         oCell2 = oSh2.getCellByPosition(intSp, intZe)   
         If oCell1.String <> oCell2.String then
            geaendert = 1
            oCell2.CellBackColor = RGB(255,255,0)
         End if
      next intZe
   next intSp
   oCell2 = oSh2.getCellByPosition(0, 0)
   if geaendert = 1 then
     oCell2.CellBackColor = RGB(255,0,0) 
   else
     oCell2.CellBackColor = RGB(0,255,0)
   end if
End Sub


Sub Tue_Zeilen_angleichen(tabeins as string, tabzwei as string, idxeins as integer, idxzwei as integer)
   '--Variablen für den Tabellenvergleich
   Dim oDoc as Object
   Dim oDocB as Object
   Dim oShFehler as Object
   Dim oAllSheetsA as Object
   Dim oAllSheetsB as Object
   Dim oSh1 as Object
   Dim oSh2 as Object
   Dim oCurSp1 as Object
   Dim oCurZe1 as Object
   Dim oCurSp2 as Object
   Dim oCurZe2 as Object
   Dim oCell1 as Object
   Dim oCell2 as Object
   Dim oCellDoku1 as Object
   Dim oCellDoku2 as Object
   Dim oView as Object 'für den View
   Dim oCellInfo as Object
   Dim oCellUeber as Object
   Dim oRange1 as Object
   Dim oRange2 as Object
   Dim oSpalte as Object 'Spaltenüberschrift der Reportabelle
   Dim intMaxZe as Integer
   Dim intMaxSp as Integer 'Zähler für die max. Zeilen- bzw. Spaltenzahl
   Dim intSp as Integer
   Dim intZe as Integer 'Zähler für Spalten- und Zeilenanfang
   Dim geaendert as Integer
   Dim mastername as String
   Dim vergleichname as String
   Dim testname as String
   Dim vglerg as Integer

   oDoc = ThisComponent
   oAllSheets = oDoc.Sheets
   oSh1 = oAllSheets.getByName(tabeins)
   oSh2 = oAllSheets.getByName(tabzwei)
   
   oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1
   oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1
   oCurSp2 = oSh2.createCursor 'Spaltenzähler für Blatt 2
   oCurZe2 = oSh2.createCursor   'Zeilenzähler für Blatt 2
   
'--Cursor für das 1. Blatt erzeugen
   oCurSp1.gotoEndofUsedArea(true)
   oCurSp1.Columns.Count
   oCurZe1.gotoEndOfUsedArea(True)
   oCurZe1.Rows.Count

'--Cursor für das 2. Blatt erzeugen
   oCurSp2.gotoEndofUsedArea(true)
   oCurSp2.Columns.Count
   oCurZe2.gotoEndOfUsedArea(True)
   oCurZe2.Rows.Count

'--maximale Zeilenzahl ermitteln
   If oCurSp1.Columns.Count > oCurSp2.Columns.Count then
      intMaxSp = oCurSp1.Columns.Count
'      msgbox(intMaxSp)
   Else
      intMaxSp = oCurSp2.Columns.Count   
'      msgbox(intMaxSp)
   End if

'--maximale Zeilenenzahl ermitteln
   If oCurZe1.Rows.Count > oCurZe2.Rows.Count then
      intMaxZe = oCurZe1.Rows.Count
   Else
      intMaxZe = oCurZe2.Rows.Count
   End if

   intSp = 0
   intZe = 0
   Do
         oCell1 = oSh1.getCellByPosition(idxeins,intZe)
         oCell2 = oSh2.getCellByPosition(idxzwei, intZe)
         vglerg = StrComp(oCell1.string, oCell2.string, 0)
         if vglerg = 1 then ' 1=Text1 ist später im Alphabet => Zeile in Tabelle1 einfügen
           oSh1.Rows.insertByIndex(intZe,1)
         elseif vglerg = -1 then ' -1=Text2 ist später im Alphabet => Zeile in Tabelle2 einfügen
           oSh2.Rows.insertByIndex(intZe,1)
         end if  
         intZe = intZe+1
   Loop Until intZe = intMaxZe
End Sub

Private sRangeSelection$,bRangeSelecting As Boolean

function getRangeSelection() as String
oController = ThisComponent.CurrentController
sTitle = "Zelle auswählen, keinen Bereich"
bAutoClose = True
sInitial = "A1"
'Dim oDoc as Object
Dim oListener as Object
Dim aProps(2) As New com.sun.star.beans.PropertyValue
   oListener = createUnoListener("RangeSelection_","com.sun.star.sheet.XRangeSelectionListener")  'create a listener
   oController.addRangeSelectionListener(oListener)  'register the listener
   aProps(0).Name = "InitialValue"
   aProps(0).Value = sInitial
   aProps(1).Name = "Title"
   aProps(1).Value = sTitle
   aProps(2).Name = "CloseOnMouseRelease"
   aProps(2).Value = bAutoClose
   With oController.getFrame
   'this is required when calling from IDE or other frame in order to avoid endless loop
      .activate
      .getContainerWindow.toFront
   End With
   bRangeSelecting = True
   oController.startRangeSelection(aProps())
   while bRangeSelecting
      wait 1000
   Wend
   oController.removeRangeSelectionListener(oListener)
   getRangeSelection = sRangeSelection
End function

Sub RangeSelection_done(oEv)
   sRangeSelection = oEv.RangeDescriptor
   bRangeSelecting = false
End Sub

Sub RangeSelection_aborted(oEv)
   sRangeSelection = ""
   bRangeSelecting = false
End Sub

Sub RangeSelection_disposing(oEv)
End Sub 

function Mache_Auswahl() as String
  Dim oDoc as Object
  Dim RangeAsText as String
  Dim Tabellenname as String
  Dim Spalte as String
  Dim pos as Integer
  Dim oCurSp1 as Object
  Dim oCurZe1 as Object
  Dim intSp as Integer
  Dim Spaltennummer as Integer
  Dim oCell1 as Object
  Dim Adresse as String
  Dim Wiederbau as String

  oDoc = ThisComponent
  oAllSheets = oDoc.Sheets
  RangeAsText = getRangeSelection()
  'Alles ab dem Doppelpunkt abschneiden, falls vorhanden
  pos = instr(RangeAsText,":")
  if pos <> 0 then
    RangeAsText = left(RangeAsText, pos-1)
  end if
   'erstes $ abschneiden
   Tabellenname = right(RangeAsText, Len(RangeAsText)-1)
   'Tabellenname zwischen Anfang und .$
   pos = instr(Tabellenname,".$")
   Tabellenname = left(Tabellenname, pos-1)
   'Tabellenname abschneiden und erstes $ gleich mit, vor Hochkommas weil pos dann neu belegt
   Spalte = right(RangeAsText, Len(RangeAsText)-pos-2)
   'Eventuelle Hochkommas abschneiden
   pos = instr(Tabellenname,"'")
   Wiederbau = Tabellenname
   if pos <> 0 then 'Name in Hochkommas
     Tabellenname = mid(Tabellenname, 2, len(Tabellenname)-2)
   end if   
   'Spalte exstrahieren, also alles bis zum nächsen $
   pos = instr(Spalte,"$")
   Spalte = left(Spalte, pos-1)
   Spalte = "$" & Wiederbau & ".$" & Spalte & "$1"
'MsgBox (Spalte)

   oSh1 = oAllSheets.getByName(Tabellenname)
   oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1
   oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1
   oCurSp1.gotoEndofUsedArea(true)
   oCurSp1.Columns.Count
   oCurZe1.gotoEndofUsedArea(true)
   intSp = 0
   Do
     oCell1 = oSh1.getCellByPosition(intSp,0)
     Adresse = oCell1.AbsoluteName
'MsgBox (Adresse & "=" & Spalte)
     if Adresse = Spalte then
       Spaltennummer = intSp
     end if
     intSp = intSp+1
   Loop Until intSp = oCurSp1.Columns.Count 
   Mache_Auswahl = Tabellenname & ":" & CStr(Spaltennummer)
End function

sub Tue_Tabelle_sortieren(tabeins as string, idxeins as integer)
rem ----------------------------------------------------------------------
rem define variables
dim dDoc as Object
dim oAllSheets as Object
dim oSh1 as Object
dim oCurSp1 as Object
dim oCurZe1 as Object
dim intMaxSp as Integer
dim intMaxZe as Integer
dim oRange
Dim oSortFields(0) as new com.sun.star.util.SortField
Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue

  oDoc = ThisComponent
  oAllSheets = oDoc.Sheets
  oSh1 = oAllSheets.getByName(tabeins)
  oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1
  oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1
  oCurSp1.gotoEndofUsedArea(true)
  oCurSp1.Columns.Count
  intMaxSp = oCurSp1.Columns.Count
  oCurZe1.gotoEndOfUsedArea(True)
  oCurZe1.Rows.Count
  intMaxZe = oCurZe1.Rows.Count
  oRange = oSh1.getCellRangeByPosition(0,0,intMaxSp,intMaxZe)

  oSortFields(0).Field = idxeins
  oSortFields(0).SortAscending = TRUE

  REM Set the sort fields to use
  oSortDesc(0).Name = "SortFields"
  oSortDesc(0).Value = oSortFields()
  
  REM Now sort the range!
  oRange.Sort(oSortDesc())
end sub