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.