The way is to consider getColumnspan and getrowspan - which IIRC would be nagative for "hidden" merged cells - but needs checking

English
#1

this is for excel code and this is working in excel = Sub CountSelectedUniqueCells()
Dim c As Range
Dim countedAreas As Object
Dim addr As String
Dim total As Long

Set countedAreas = CreateObject("Scripting.Dictionary")
total = 0

For Each c In Selection.Cells
    If c.MergeCells Then
        addr = c.MergeArea.Address
        If Not countedAreas.exists(addr) Then
            countedAreas(addr) = True
            total = total + 1
        End If
    Else
        total = total + 1
    End If
Next c

MsgBox "Total selected cells : " & total, vbInformation, "Cell Count"

End Sub

BUT NOW I HAVE TO DO IN THIS LIBREOFFICE UNDERSTAND so can u help me

#2

Could you, please, tell in simple words what the Sub
Sub CountSelectedUniqueCells()
is expected to do?
What’s a selected unique cell ?

#3

sounds like a variation of: this python snippet which is adapted from this basic snippet

#4

I want to count how many visible cell blocks are in a selected range.
For example, if I select A2:A20 and there are some merged cells inside,
each merged block should count as one, and each unmerged cell should also count as one.

So, if A2:A4 is merged, A5, A6, A7 are single cells, A8:A12 is merged, and so on —
the expected total should be the number of unique visible cell blocks (merged or unmerged).

My problem is that LibreOffice Basic counts all internal merged cells separately instead of treating merged blocks as one.

#5

Thanks for the quick response!
I want to count how many unique visible cells (merged or unmerged) exist in a selected range. Each merged block should be counted once only…

#6

Sorry its python

from msgbox import MsgBox

def messagebox( message, deko=4, title="Read_ME" ):
    msg = MsgBox( XSCRIPTCONTEXT.ctx )
    msg.addButton( 'ok' )
    msg.show( message, deko, title=title)

def count_visible_in_single_selection(*_):
    """
    todo: works only for any _merged_ area
    with upper/left cell **inside** selection
    """
    doc = XSCRIPTCONTEXT.getDocument()
    sel = doc.CurrentSelection
    sheet = sel.Spreadsheet
    total = (rc:=sel.Rows.Count) * (cc:=sel.Columns.Count)
    for r in range(rc):
        for c in range(cc):
            if sel[r,c].IsMerged:
                cursor = sheet.createCursorByRange(sel[r,c])
                cursor.collapseToMergedArea()
                total -= min((rc, cursor.Rows.Count)) * min((cc, cursor.Columns.Count))
                total+=1
    messagebox(f"{total = }", title="number of visible Cells in Selection")
#7

Hello, @karolus , @Lupp, and colleagues!
I suggest the SelectionStat macro with the same idea. Also works when multiple rectangular ranges are selected.
Considering that entire columns and rows can be selected, using the getUniqueCellFormatRanges method seems useful.

In Python, the text will naturally be shorter. Python also has native dictionaries.

Option Explicit

' Counts the number of cells in a rectangular range, taking into account any merged cells.
Function CountUniqueCells(Byval oRange as Object) as Double
  Dim oSheet as Object, oRanges as Object, oRg as Object, oRangeBig as Object
  Dim oCur as Object, absoluteName as String, total as Double
  Dim oMap as Object, adrRange, adrRg
  
  oSheet = oRange.Spreadsheet 
  oMap = com.sun.star.container.EnumerableMap.create("string", "string")
  adrRange = oRange.RangeAddress
  total = GetCellCount(adrRange)
  adrRange = oRange.RangeAddress  
  oRangeBig = oSheet.GetCellRangeByPosition(0, 0, adrRange.EndColumn, adrRange.EndRow)
  For Each oRanges In oRangeBig.getUniqueCellFormatRanges()
    For Each oRg In oRanges
      If oRg.getIsMerged() Then
        oCur = oSheet.createCursorByRange(oRg)
        oCur.collapseToMergedArea()
        absoluteName = oCur.AbsoluteName
        If Not oMap.containsKey(absoluteName) Then
          oMap.put absoluteName, ""           

          ' Calculating the intersection of ranges oRange and oRg          
          adrRg = oCur.RangeAddress
          With adrRg
            If .StartRow < adrRange.StartRow Then .StartRow = adrRange.StartRow
            If .StartColumn < adrRange.StartColumn Then .StartColumn = adrRange.StartColumn          
            If .EndRow > adrRange.EndRow Then .EndRow = adrRange.EndRow
            If .EndColumn > adrRange.EndColumn Then .EndColumn = adrRange.EndColumn
            If .EndColumn >= .StartColumn And .EndRow >= .StartRow Then
              total = total + 1 - GetCellCount(adrRg)
            End If  
          End With  
        End If  
      End If    
    Next oRg  
  Next oRanges
  CountUniqueCells = total
End Function


' Returns the number of cells in a rectangular range.
Function GetCellCount(Byval adrRange as Object) as Double
  With adrRange
    GetCellCount = CDbl(.EndRow - .StartRow + 1) * CDbl(.EndColumn - .StartColumn + 1)
  End With
End Function


' Shows statistics of selected cells
Sub SelectionStat()
  Dim oSel as Object, aRanges, oRange as Object, adrRange
  Dim nAreas as Double, nCells as Double, nUniqueCells as Double
  oSel =  ThisComponent.CurrentSelection
  If HasUnoInterfaces(oSel, "com.sun.star.sheet.XSheetCellRange") Then
    aRanges = Array(oSel)
  ElseIf HasUnoInterfaces(oSel, "com.sun.star.sheet.XSheetCellRanges") Then   
    aRanges = oSel
  Else
    Msgbox "No cells selected"
    Exit Sub
  End If  
  
  For Each oRange In aRanges
    nAreas = nAreas + 1
    adrRange = oRange.RangeAddress 
    nCells = nCells + GetCellCount(adrRange)
    nUniqueCells = nUniqueCells + CountUniqueCells(oRange)                   
  Next   
  
  Msgbox "Areas: " & nAreas & Chr(10) & _
         "Cells: " & nCells & Chr(10) & _
         "UniqueCells: " & nUniqueCells
End Sub
#8

By the way, if you select several columns in Excel and run the macro from the startup message, the program will go into deep thought…
Excel doesn’t have an equivalent to the getUniqueCellFormatRanges method. To effectively solve this problem, you can search for cells (Range.Find) in Excel by the corresponding format.


The SelectionStat macro (for Calc) works quickly even if all cells in the sheet are selected.

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.