makro, das zwei tabellen vergleicht

[kannenklaus]

hallo ng

kennt jemand ein makro das zwei calc-tabellen vergleicht und die unterschiede in ein extra blatt kopiert.

freue mich auf eine antwort

grüße

klaus

[RS]

Hallo Klaus,

vielleicht kann Dir einer der folgenden Beiträge eine Hilfe sein (die meisten stammen aus dem englischsprachigen Forum; da ich von der Materie an sich auf Grund der Komplexität wenig verstehe, habe ich keinen der Beiträge "ausprobiert"):

http://www.oooforum.org/forum/viewtopic ... +documents

http://www.oooforum.org/forum/viewtopic ... +documents

http://www.oooforum.org/forum/viewtopic ... ht=compare

http://www.ooo-portal.de/index.php?modu ... topic=2040

Gruß,

Rebecca

[kannenklaus]

hallo rebecca,

danke für deine links. das was ich suche war leider nicht dabei.

grüße

klaus

[kannenklaus]

hallo gruppe,

inzwischen konnte ich den code, der zwei tabellen vergleicht, selbst erstellen. das ergebnis wird in einem extra reportblatt dokumentiert. hyperlinks zu den abweichenden zellen werden automatisch mit erzeugt.

grüße

klaus

Code: Alles auswählen

Sub TabellenVergleichen

	'--Variablen für den Tabellenvergleich
	Dim oDoc, oShFehler, oSh1, oSh2 as Object
	Dim oCurSp1, oCurZe1, oCurSp2, oCurZe2 as Object
	Dim oCell1, oCell2, oCellDoku1, oCellDoku2 as Object
	Dim oView as Object 'für den View
	Dim oCellInfo, oCellUeber as Object
	Dim oRange1, oRange2, oSpalte as Object 'Spaltenüberschrift der Reportabelle
	Dim intMaxZe, intMaxSp as Integer 'Zähler für die max. Zeilen- bzw. Spaltenzahl
	Dim intSp, intZe as Integer 'Zähler für Spalten- und Zeilenanfang
	
	'--Variablen für das Blatt Report
	Dim i, iSp as Integer 'Zähler für die Zellen des Reportblattes bzw. für die Spalten A bis D
	Dim strRep as string 'Variable für den Blattnamen des Reports
	Dim oField, oText as Object
	Dim oCellHyp1, oCellHyp2 as Object 'Zielzelle der Hyperlinks-Zellen
	Dim strPrae as String 'Präfix des Hypelrinks=#
	Dim strCell1Adr, strSpCell1, strZeCell1 as String 'Stringvariablen für den Hyperlinknamen des 1.Blattes
	Dim strCell2Adr, strSpCell2, strZeCell2 as String 'Stringvariablen für den Hyperlinknamen des 1.Blattes
	oDoc = ThisComponent
	strRep = "Report abweichende Einträge"
	
	
'--Falls das Blatt Report doppelte Einträge vorhanden ist, löschen ansonsten anlegen
	If oDoc.Sheets.hasByName(strRep) = true Then
		MsgBox ("Das Blatt "+strRep+" ist vorhanden"+chr(13)+ _
		"und wird gelöscht und dann neu angelegt.",0,"B+P-->Zwei Blätter vergleichen")
		oDoc.Sheets.RemoveByName(strRep)
	End If
	oDoc.Sheets.InsertNewByName(strRep,0)
	
'--Referenzieren bzw. Objekte erzeugen
	oShFehler = oDoc.Sheets.getByName(strRep)
	oSh1 = oDoc.Sheets(1)
	oSh2 = oDoc.Sheets(2)
	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
'	MsgBox("Das Blatt "+oSh1.name +" hat "+oCurSp1.Columns.Count+" Spalten")
'	MsgBox("Das Blatt "+oSh1.name +" hat "+oCurZe1.Rows.Count+" Zeilen")


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

'	MsgBox("Das Blatt "+oSh2.name + " hat "+oCurSp2.Columns.Count+" Spalten")
'	MsgBox("Das Blatt "+oSh2.name + " hat "+oCurZe2.Rows.Count+" Zeilen")
	
'--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
i = 1
' Zwei For/next-Schleifen, um Zellen der beiden Tabellenblätter vergleichen
	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
			'If StrComp(oCell1.string, oCell2.string)<> 0 then			
				'--abweichende Werte des ersten Blattes eintragen				
				oCellDoku1 = oShFehler.getCellByPosition(1,i)
				oCellDoku1.String=oCell1.String
				
				'--Hyperlink auf die abweichende Zelle des ersten Blattes erstellen
				strPrae = "#"'1.Teil des Hyperlinksnamens
				'--abweichende Zelladresse ermitteln
				oCell1 =oSh1.getCellByPosition(intSp,intZe).getCellAddress
				strSpCell1=oDoc.Sheets(oCell1.sheet).Columns(oCell1.Column).name
				strZeCell1= oCell1.Row+1  
				strCell1Adr=strSpCell1+strZeCell1'Spalte und Zeile zur Zelladresse zusammenfassen	
				'--Textfeld für Hyperlink erzeugen
				oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")'URL Textfeld erzeugen
				oField.Representation =strCell1Adr 'Text, der im Hyperlink erscheint 
				oField.URL = ConvertToURL(strPrae+oSh1.name+"."+strCell1Adr)'erstellt den Hyperlink
				
				'--Erzeugt den Hyperlink
				oCellHyp1 = oShFehler.getCellByPosition(0,i)'Zielzelle des Hyperlink
				oText = oCellHyp1.getText()
				oText.insertTextContent(oText.createTextCursor(), oField, False)

				'--abweichende Werte des zweiten Blattes eintragen
				oCellDoku2 = oShFehler.getCellByPosition(3,i)
				oCellDoku2.String=oCell2.String
				
				'--Hyperlink auf die abweichende Zelle des ersten Blattes erstellen
				strPrae = "#"'1.Teil des Hyperlinksnamens
				'--abweichende Zelladresse ermitteln
				oCell2 =oSh2.getCellByPosition(intSp,intZe).getCellAddress
				strSpCell1=oDoc.Sheets(oCell2.sheet).Columns(oCell2.Column).name
				strZeCell1= oCell2.Row+1  
				strCell1Adr=strSpCell1+strZeCell1'Spalte und Zeile zur Zelladresse zusammenfassen	
				'--Textfeld für Hyperlink erzeugen
				oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")'URL Textfeld erzeugen
				oField.Representation =strCell1Adr 'Text, der im Hyperlink erscheint 
				oField.URL = ConvertToURL(strPrae+oSh2.name+"."+strCell1Adr)'erstellt den Hyperlink
				
				'--Erzeugt den Hyperlink
				oCellHyp2 = oShFehler.getCellByPosition(2,i)'Zielzelle des Hyperlink
				oText = oCellHyp2.getText()
				oText.insertTextContent(oText.createTextCursor(), oField, False)								
			i = i+1
			End if
		next intZe
	next intSp

'---Reporttabelle:Spaltenbreite auf definierte Werte einstellen
	'--Spalten B und D werden festgelegt
	for iSp = 1 to 3 step 2 
		oSpalte = oShFehler.columns(iSp)
		oSpalte.width = 5000
		oSpalte.isTextWrapped = true 'Umbruch in der Zelle
		oSpalte.ParaIsHyphenation = true 'Silbentrennung in der Zelle
		oSpalte.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT 'Schrift in Spalten links ausrichten
		oSpalte.VertJustify = com.sun.star.table.CellVertJustify.TOP 'Schrift in Spalten oben ausrichten
	next iSp

	'--Spalten A und C werden festgelegt
	for iSp = 0 to 2 step 2
		oSpalte = oShFehler.columns(iSp)
		oSpalte.width = 1000
		oSpalte.isTextWrapped = true 'Umbruch in der Zelle
		oSpalte.ParaIsHyphenation = true 'Silbentrennung in der Zelle
		oSpalte.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT 'Schrift in Spalten links ausrichten
		oSpalte.VertJustify = com.sun.star.table.CellVertJustify.TOP 'Schrift in Spalten oben ausrichten
	next iSp

'- Reporttabelle anlegen, formatieren
	oShFehler.rows.InsertByIndex(0,2)
	oShFehler.rows(1).height = 120
	oCellUeber = oShFehler.getCellByPosition (0,0)
	with oCellUeber
		.isTextWrapped = False
		.CharWeight = com.sun.star.awt.FontWeight.BOLD
		.CharHeight = 14
		.setString("Liste der abweichenden Zellwerte von "+oSh1.name+" und "+oSh2.name)
	end with
	
	'--1.Überschrift für Tabelle 1
	oRange1=oShFehler.getCellByPosition(0,2)
	oRange1.setString("Abweichungen: "+oSh1.name+" ggü. "+oSh2.name)
	oRange1=oShFehler.getCellRangeByName("A3:B3")
	with oRange1
		.merge(true)
		.CellBackColor = RGB(41, 191, 30)
		.CharHeight = 9
		.CharColor= RGB(255, 255, 255) 'für weiße Schrift
		.CharWeight = com.sun.star.awt.FontWeight.BOLD
		.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
	end with
		
	'--2. Überschrift für Tabelle 2
	oRange2=oShFehler.getCellByPosition(2,2)
	oRange2.setString("Abweichungen: "+oSh2.name+" ggü."+oSh1.name)
	oRange2=oShFehler.getCellRangeByName("C3:D3")
	with oRange2
		.merge(true)
		.CellBackColor = RGB(141, 11, 30)
		.CharHeight = 9
		.CharColor= RGB(255, 255, 255) 'für weiße Schrift
		.CharWeight = com.sun.star.awt.FontWeight.BOLD	
		.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
	end with
	
'--Meldung,wenn es keine Unterschiede gibt
	If i=1 then
		MsgBox("Die zu vergleichenden Blätter sind identisch. Im Blatt "+strRep+ _
		" werden keine Unterschiede eingetragen.",0,"B+P Auswertungsinfo")
		oShFehler.Rows.removeByIndex(1,2)'Überschriftzeile löschen
		with oShFehler.getCellByPosition (0,1)'Zelleintrag für den Fall, wenn beide Blätter gleich sind
			.setString("Ergbenis: Beide Tabellen sind gleich")
			.CharWeight = com.sun.star.awt.FontWeight.BOLD
			.isTextWrapped=False
		end with
	End if


'--zum Reporttabellenblatt wechseln	
	oView=oDoc.CurrentController
	oView.setActiveSheet(oShFehler)
End Sub

[ykcim]

Hallo Klaus,

ein kleiner Hinweis.

Wenn man Variablen in Starbasic deklariert, muß man jeder Variablen den Typ explizit zuweisen. Eine Verkettung wie in manchen anderen Programmiersprachen geht nicht!

Code: Alles auswählen

   Dim oDoc, oShFehler, oSh1, oSh2 as Object
   Dim oCurSp1, oCurZe1, oCurSp2, oCurZe2 as Object 

Damit haben die Variablen oDoc, oShFehler, oSh1 den Typ Variant und oSh2 den Typ Object

Richtig ist:

Code: Alles auswählen

   Dim oDocas Object, oShFehler as Object, oSh1 as Object

Bei einem Objekt ist das in der Regel nicht kritisch, aber bei Zahlen kann es für durcheinander sorgen.
Siehe auch hier:
http://www.starbasicfaq.de/Warumhabenma ... dnich.html

mfg
Michael