Calc cells spreadsheet merge join same equal content formula value string Michael Hoennig Tom Schindl 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
		

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.

'======================================================================== '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

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.

'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
Modified to match new snippet-DTD initial release