[RESUELTO]Macro para contar según color de fondo de la celda

[AntonioSV]

Perdonad que vuelva a preguntar tan seguido, pero en mi empresa estamos cambiando de Office a LibreOffice y, de momento, estoy desubicado.
En excel para contar celdas según el color de fondo de las mismas utilizo esta macro:

Function ContarColorFondo(rngCeldaColor As Range, rngRangoAContar As Range) As Long
Dim rngCelda As Range

For Each rngCelda In rngRangoAContar
If rngCelda.Interior.ColorIndex = rngCeldaColor.Cells(1, 1).Interior.ColorIndex Then ContarColorFondo = ContarColorFondo + 1
Next rngCelda

Set rngCelda = Nothing
End Function

¿Podéis decidme cómo sería en LibreOffice?.

Gracias, de antemano, a todos por atenderme.
Un saludo.

[PepeOooSevilla]

Hola.

El tema de las macros no es fácil. Si te manejas con más o menos soltura no hay problema, pero si no ... El libro Aprendiendo OOo Basic de nuestro compañero mauricio es una muy buena guía de referencia (aunque él te diría que aprendieras Python y no Basic).

Buceando por internet encontré esta macro que sumaba el contenido de las celdas dependiendo de su color de fondo. La he modificado para que, en lugar de sumar, cuente cúantas celdas hay de cada color de fondo. Como los parámetros están definidos como String debes tener en cuenta que no se actualizarán los rangos de celdas cuando copies y pegues. Tendrás que actualizarlos manualmente.

Código: Seleccionar todo

Option Explicit

Public Function CountIfColor(CountRange As String, ColorCell As String) As Long
    Dim oRange as object
    Dim oColorRange as object
    Dim oColorCell as object
    Dim oSheet as object
    Dim oCell as object
    Dim lngCount as Long
    Dim intCol as integer
    Dim intRow as integer

    ' Get Access to the Active Spreadsheet
    oSheet = ThisComponent.CurrentController.ActiveSheet 
    
    ' Get access to the Range listed in Count Range
    oRange = oSheet.getCellRangeByName(CountRange).RangeAddress
    
    ' get Access to the cell in ColorCell
    oColorRange = oSheet.getCellRangeByName(ColorCell).RangeAddress
    oColorCell = oSheet.getCellByPosition(oColorRange.StartColumn, oColorRange.StartRow)
    
    ' Loop Through all the Cells in the Range
    For intRow = oRange.StartRow to oRange.EndRow
        For intCol = oRange.StartColumn to oRange.EndColumn
            oCell = oSheet.getCellbyPosition(intCol, intRow)
            If oCell.CellBackColor = oColorCell.CellBackColor Then
                lngCount = lngCount + 1
            End if
        Next
    Next
    CountIfColor = lngCount
End Function

En este tema [RESUELTO] Filtrar por color, fornelasa nos ofrece una manera de filtrar por colores, también con macros.

Personalmente, recurro a las macros cuando me resulta imposible realizar una tarea con las herramientas que me ofrece Calc. Procuro no utilizar macros siempre que puedo, y, sobre todo, si esa hoja de cálculo va a ser usada por otras personas. Digo esto porque, haciendo uso del "formato condicional" se pueden "colorear" las celdas según su contenido. Y si el color de fondo coincide con el color del texto te parecerá que la celda está "vacía" pero coloreada. De esta manera puedes contarlas con un simple CONTAR.SI() o, incluso, crear una tabla dinámica como puedes comprobar en el archivo adjunto. Observa los estilos de celda creados y haz pruebas.

• Cuando consideres que el tema está resuelto, indícalo (¿Cómo marcar como RESUELTO un tema?), ya que, de esta forma, conseguiremos un foro más ordenado.

Saludos cordiales.

[AntonioSV]

Gracias Pepe por la atención prestada.

Probaré lo que me has enviado.

[droplon]

hola, buenos días! llegué aquí buscando una respuesta a un tema parecido.
Necesito contar las celdas según el color del texto, no del fondo del la celda.
Es posible???

[FJCC-ES]

Cambié CellBackColor a CharColor

Código: Seleccionar todo

Option Explicit

Public Function CountIfColor(CountRange As String, ColorCell As String) As Long
    Dim oRange as object
    Dim oColorRange as object
    Dim oColorCell as object
    Dim oSheet as object
    Dim oCell as object
    Dim lngCount as Long
    Dim intCol as integer
    Dim intRow as integer

    ' Get Access to the Active Spreadsheet
    oSheet = ThisComponent.CurrentController.ActiveSheet 
    
    ' Get access to the Range listed in Count Range
    oRange = oSheet.getCellRangeByName(CountRange).RangeAddress
    
    ' get Access to the cell in ColorCell
    oColorRange = oSheet.getCellRangeByName(ColorCell).RangeAddress
    oColorCell = oSheet.getCellByPosition(oColorRange.StartColumn, oColorRange.StartRow)
    
    ' Loop Through all the Cells in the Range
    For intRow = oRange.StartRow to oRange.EndRow
        For intCol = oRange.StartColumn to oRange.EndColumn
            oCell = oSheet.getCellbyPosition(intCol, intRow)
            If oCell.CharColor = oColorCell.CharColor Then  'FJCC ###############
                lngCount = lngCount + 1
            End if
        Next
    Next
    CountIfColor = lngCount
End Function