OO-Snippets:

Commons

KeywordsCalc, cells, spreadsheet, merge, join, same, equal, content, formula, value, string
LanguageOOBasic
ApplicationCalc
AuthorsMichael Hoennig (initial)
Tom Schindl
Supported Versions
Supported OS
Question How can I merge subsequent cells with same value?

E.g. a table like:

A       A       1	
A       B       1
A       B       1
A       B       1
A       B       2
B       A       1
B       A       1
B       A       1
B       A       2
B       B       1
B       B       2
B       B       2

Will be transformed into:

A	A       1	
        B       1
		
		
                2
B       A       1
		
		
                2
        B       1
                2
Answer

The following macro joins all cells in the same column which are next to each other and have the same value. For each joined area, ehe macro continunes with subsequent columns as long as it stays in the selection.

This first macro works on the current selection. It calls the subroutine defined below for the actual merge process.

The following macro is the actual implementation of the merge process. It could be used programmatically as it receives the document and selection to work on as arguments.

Code-Snippet-Listing (snippet-source)

'========================================================================
'merge equal cells in selected area
Sub mergeEqualCellsInSelectedColumns

'get selected area
aDoc = StarDesktop.CurrentComponent
aSelection = aDoc.getCurrentSelection()
aArea = aSelection.getRangeAddress()

'merge the selected area in active document
mergeEqualCellsInColumns( aDoc, aArea )

End Sub


'merge equal cells in each column of the given area in the given document
Sub mergeEqualCellsInColumns( aDoc as object, aArea as com.sun.star.table.CellRangeAddress )

'get some commonly used objects
aSheet = aDoc.getSheets().getByIndex( aArea.Sheet )

'enumerate through all rows of the selection
for nRow = aArea.StartRow to aArea.EndRow

	'only work on the first column yet
	nCol = aArea.StartColumn

	'get initial cell in row
	aStartCell = aSheet.getCellByPosition( nCol, nRow )
	aCursor = aSheet.createCursorByRange( aStartCell )

	'find first cell with different content
	nCompareRow = nRow+1
	while ( nCompareRow <= aArea.EndRow and _
			aSheet.getCellByPosition( nCol, nCompareRow ).getFormula() = aStartCell.getFormula() )
		nCompareRow = nCompareRow + 1
	wend
	nLastEqualRow = nCompareRow-1

	'are here equal cells at all?
	if ( nLastEqualRow > nRow ) then
		'merge range of all cells with identical content
		aRange = aSheet.getCellRangeByPosition( nCol, nRow, nCol, nLastEqualRow )
		aRange.merge(true)
		aRange.VertJustify = 1
	
		'if next column is still part of the subjected area
		if nCol < aArea.EndColumn then
			'specify the area in the next column within the merged rows
			dim aSubArea as new com.sun.star.table.CellRangeAddress
			aSubArea.Sheet = aArea.Sheet
			aSubArea.StartRow = nRow
			aSubArea.EndRow = nLastEqualRow
			aSubArea.StartColumn = nCol+1
			aSubArea.EndColumn = aArea.EndColumn
		
			'recursively merge the cells in this area right of the merged area
			mergeEqualCellsInColumns( aDoc, aSubArea )
		endif
	endif

	'continue after merged area
	nRow = nLastEqualRow
next
End Sub

Changelog

DateUserModification
2004-06-22tomsontomModified to match new snippet-DTD
0000-00-00miinitial release

and