Spalten in andere Tabellen kopieren. Elegantere Lösung?

Antwort erstellen

BBCode ist eingeschaltet
[img] ist ausgeschaltet
[url] ist eingeschaltet
Smileys sind ausgeschaltet
Die letzten Beiträge des Themas
   

Ansicht erweitern Die letzten Beiträge des Themas: Spalten in andere Tabellen kopieren. Elegantere Lösung?

Re: Spalten in andere Tabellen kopieren. Elegantere Lösung?

von retuwe61 » Di, 25.09.2012 06:34

Vielen Dank für die Mühe. Hast es toll beschrieben und ich weiß jetzt Bescheid.
Gruß
Uwe

Re: Spalten in andere Tabellen kopieren. Elegantere Lösung?

von DPunch » Mo, 24.09.2012 22:42

Servus

am kompaktesten hält man grundsätzlich gleichartige Operationen, indem man den kleinsten gemeinsamen Nenner extrahiert und den Rest in einem (oder mehreren Arrays) unterbringt.
In Deinem Falle wäre das
Fest:
Quelltabelle: "Daten"
Zielspalten: "A" und "B"
Variabel:
Zieltabelle: "A", "B" oder "C"
Quellspalten: "A" und "B", "A" und "D" oder "A" und "H"

ergibt:

Code: Alles auswählen

REM single operation: Array("TargetSheet","SourceColumn 1","SourceColumn 2")
	Dim aOperations(2)
	aOperations(0) = Array("A","A","B")
	aOperations(1) = Array("B","A","D")
	aOperations(2) = Array("C","A","H")
	oDoc = thisComponent
	oSheets = oDoc.Sheets
	oSrcSheet = oSheets.getByName("Daten")
	oCursor = oSrcSheet.createCursor
	oCursor.goToEndOfUsedArea(False)
	nLastRow = oCursor.RangeAddress.EndRow
	For Each currentOperation In aOperations
		aData = oSrcSheet.getCellRangeByName(currentOperation(1) & "1:" & currentOperation(1) & nLastRow+1).getDataArray
		oSheets.getByName(currentOperation(0)).getCellRangeByName("A1:A" & nLastRow+1).setDataArray(aData)
		aData = oSrcSheet.getCellRangeByName(currentOperation(2) & "1:" & currentOperation(2) & nLastRow+1).getDataArray
		oSheets.getByName(currentOperation(0)).getCellRangeByName("B1:B" & nLastRow+1).setDataArray(aData)
	Next currentOperation
Wenn man sich aber sowieso die Mühe macht, das Ganze zusammenzufassen, kann man auch gleich eine eigene Prozedur erstellen, die variabel weiterverwendbar ist:

Code: Alles auswählen

Sub Mainx	
	CopyColumns("Daten","A",Array("A","B"),Array("A","B"))
	CopyColumns("Daten","B",Array("A","D"),Array("A","B"))
	CopyColumns("Daten","C",Array("A","H"),Array("A","B"))
	REM oder auch
	REM CopyColumns("Daten","C",Array("A","B","C","D","E"),Array("F","G","H","I","J"))
	REM oder
	REM sURL = ConvertToURL("D:\meineCalcDatei.ods")
	REM CopyColumns("Daten","C",Array("A","B","C","D","E"),Array("F","G","H","I","J"),StarDesktop.loadComponentFromURL(sURL,"_blank",0,Array())	
End Sub

REM CopyColumns
REM Usage:
REM @sourceSheet: name of sheet to copy from
REM @targetSheet: name of sheet to copy to
REM @srcColumns: array of column names in source sheet
REM @targetColumns: array of column names in target sheet
REM OPTIONAL @document: document to operate on
Sub CopyColumns(srcSheet,targetSheet,srcColumns,targetColumns,Optional document)
	If isMissing(document) Then document = thisComponent
	If NOT document.supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
		MsgBox srcSheet & "->" & targetSheet & ": Unsupported document type",48,"Aborting CopyColumns"
		Exit Sub
	End If
	oSheets = document.Sheets
	If NOT oSheets.hasByName(srcSheet) Then
		MsgBox srcSheet & "->" & targetSheet & ": Sheet """ & srcSheet & """ not found",48,"Aborting CopyColumns"
		Exit Sub
	ElseIf NOT oSheets.hasByName(targetSheet) Then
		MsgBox srcSheet & "->" & targetSheet & ": Sheet """ & targetSheet & """ not found",48,"Aborting CopyColumns"
		Exit Sub
	ElseIf VarType(srcColumns) < 8200 Then
		MsgBox srcSheet & "->" & targetSheet & ": Illegal argument passed for source column list",48,"Aborting CopyColumns"
		Exit Sub
	ELseIf VarType(targetColumns) < 8200 Then
		MsgBox srcSheet & "->" & targetSheet & ": Illegal argument passed for target column list",48,"Aborting CopyColumns"
		Exit Sub
	ElseIf UBound(srcColumns) = -1 Then
		MsgBox srcSheet & "->" & targetSheet & ": Empty column list for """ & srcSheet & """",48,"Aborting CopyColumns"
		Exit Sub
	ElseIf UBound(targetColumns) = -1 Then
		MsgBox srcSheet & "->" & targetSheet & ": Empty column list for """ & targetSheet & """",48,"Aborting CopyColumns"
		Exit Sub
	ElseIf LBound(srcColumns) <> LBound(targetColumns) OR UBound(srcColumns) <> UBound(targetColumns) Then
		MsgBox srcSheet & "->" & targetSheet & ": Column count does not match",48,"Aborting CopyColumns"
		Exit Sub
	End If	
	oSrcSheet = oSheets.getByName(srcSheet)
	oTargetSheet = oSheets.getByName(targetSheet)
	oCursor = oSrcSheet.createCursor
	oCursor.goToEndOfUsedArea(False)
	nLastRow = oCursor.RangeAddress.EndRow
	For columnCounter = LBound(srcColumns) To UBound(srcColumns)
		sSourceColumnName = srcColumns(columnCounter)
		sTargetColumnName = targetColumns(columnCounter)
		If NOT oSrcSheet.Columns.hasByName(sSourceColumnName) Then
			MsgBox srcSheet & "->" & targetSheet & ": Column """ & sSourceColumnName & """ not found in sheet """ & oSrcSheet.Name & """",48,"Aborting CopyColumns"
			Exit Sub
		ElseIf NOT oTargetSheet.Columns.hasByName(sTargetColumnName) Then
			MsgBox srcSheet & "->" & targetSheet & ": Column """ & sTargetColumnName & """ not found in sheet """ & oTargetSheet.Name & """",48,"Aborting CopyColumns"
			Exit Sub
		End If
		aData = oSrcSheet.getCellRangeByName(sSourceColumnName & "1:" & sSourceColumnName & nLastRow+1).getDataArray
		oTargetSheet.getCellRangeByName(sTargetColumnName & "1:" & sTargetColumnName & nLastRow+1).setDataArray(aData)
	Next columnCounter
End Sub
Durch die Arbeit mit Arrays bzw. Arrays von Arrays sind der Fantasie fast keine Grenzen gesetzt, du könntest also in dieser einen Prozedur z.B. auch noch die Start-/Endzeilen pro Sheet festlegen, mehrere Quellsheets, aus denen unterschiedliche Spalten kopiert werden sollen, Spaltenbereiche statt einzelner Spalten als Parameter akzeptieren etcetc.
Dabei muss man allerdings immer die Handhabbarkeit der Prozedur im Auge behalten, die tollsten Funktionalitäten bringen nichts, wenn sich kein Mensch die Aufrufparameter merken kann.

Spalten in andere Tabellen kopieren. Elegantere Lösung?

von retuwe61 » Mo, 24.09.2012 20:04

Hallo miteinander.
Aus der Tabelle "Daten" möchte ich jeweils die Inhalte der Spalten A und B, A und D, sowie A und H in die Tabellen "A", "B" und "C" , jeweils in die Spalten A und B kopieren.
Dafür verwende ich diesen Code, den ich gerne kompakter hätte. Ich habe schon einige Fehlversuche hinter mir.
Ist wahrscheinlich für euch kein Problem.
Ich bin gespannt.
Gruß
Uwe

Code: Alles auswählen

sub Bereich_Daten_verteilen

   oDoc = thiscomponent
   oSheet1 = oDoc.Sheets.getByName("Daten")
'   oSheet2 = oDoc.Sheets.getByName("Leer")
   oSheet3 = oDoc.Sheets.getByName("A")
   oSheet4 = oDoc.Sheets.getByName("B")
   oSheet5 = oDoc.Sheets.getByName("C")
 
   oCellCursor = oSheet1.createCursor()
   oCellCursor.GotoEndOfUsedArea(True)
   letzte_Zeile = oCellCursor.getRangeAddress.EndRow
 
aQuelle = Array(0,1)
aZiel   = Array(0,1)

for i = 0 to uBound(aQuelle)

oQuelleRange = oSheet1.getCellRangeByPosition(aQuelle(i),0,aQuelle(i),letzte_Zeile)
aDat = oQuelleRange.getDataArray()

oZielRange = oSheet3.getCellRangeByPosition(aZiel(i),0,aZiel(i),letzte_Zeile)
oZielRange.setDataArray(aDat)

next i

aQuelle = Array(0,4)
aZiel   = Array(0,1)


for i = 0 to uBound(aQuelle)

oQuelleRange=oSheet1.getCellRangeByPosition(aQuelle(i),0,aQuelle(i),letzte_Zeile)
aDat = oQuelleRange.getDataArray()

oZielRange = oSheet4.getCellRangeByPosition(aZiel(i),0,aZiel(i),letzte_Zeile)
oZielRange.setDataArray(aDat)

next i

aQuelle = Array(0,7)
aZiel   = Array(0,1)


for i = 0 to uBound(aQuelle)

oQuelleRange=oSheet1.getCellRangeByPosition(aQuelle(i),0,aQuelle(i),letzte_Zeile)
aDat = oQuelleRange.getDataArray()

oZielRange = oSheet5.getCellRangeByPosition(aZiel(i),0,aZiel(i),letzte_Zeile)
oZielRange.setDataArray(aDat)

next i

end sub

Nach oben