codigo para contar celdas de X color

Primero vamos a colorear unas cuantas celdas del rango
D1:D30. Para ello ejecuta el siguiente código:

Sub colorea()
Dim Celda
Dim R As Range
Set R = Range("D1.D30")
R.Select
For Each Celda In R
Celda.Interior.ColorIndex = Int(Rnd * 10) + 1
Next
End Sub


En el código anterior hemos pedido que nos coloree con un
máximo de 10 colores, aunque sabemos que existen 56
colores distintos.

En segundo lugar ejecuta esta macro:

Sub pru()
MsgBox "Celdas de color Rojo (3): " & CuentaColor
(Range("D6.D30"), 3)
End Sub


Se basa en la función CuentaColor, que cuenta el color
rojo (número 3).


Function CuentaColor(R As Range, tono As Byte) As Byte
Dim num As Long
Dim Celda
For Each Celda In R
If Celda.Interior.ColorIndex = 3 Then num = num +
1
Next
CuentaColor = num
End Function


Si quieres listar todos los colores ejecuta esta macro:

Sub marcas()
'Pone un tono de color a cada celda entre 1 y 56
Dim i As Integer
For i = 1 To 56
With Range("C5").Offset(i, 0)
.Value = i
.Interior.ColorIndex = i
.Interior.Pattern = xlSolid
End With
Next
End Sub

Estoy pensando que aún no lo he probado con mi tio que es
daltónico.

Un saludo.

Adolfo Aparicio

q onda raza!
alguien me puede pasar el codigo - formula para contar

el numero de celdas

que tienen X's color (trama)

saludos!!

atte. miguelrdz.com



.

hola, chicos !

aprovechando que ya Adolfo te ha comentado acerca de los colores en 'ColorIndex'...
[solo] unas [pequeñas] 'sugerencias' ;)
-> la funcion que propone Adolfo 'devuelve' un resultado con el tipo de datos 'Byte'
[0 a 255] -> si el rango que se 'cuenta' tiene mas de 255 'coincidencias'... ×-×
consulta en la ayuda de vba los tipos de datos y sus 'alcances'/consumo de memoria :)

con los cambios propuestos, puedes llamar desde la hoja de calculo la funcion [p.e.]
- suponiendo que la celda 'C1' tiene el mismo color de fondo que deseas contar en el rango 'A1:A5001
=ContarColor(A1:A500,C1)
- suponiendo que conoces que el numero de color que deseas contar en el # 3
=ContarColor(A1:A500,3)
=>ojo que 'mi' separador de argumentos es la coma<= ;)

saludos,
hector.
la funcion en un modulo de codigo 'normal' ==Function ContarColor(ByVal Rango As Range, ByVal Color) As Long
Dim Celda As Range, Total As Long
If TypeName(Color) = "Range" Then Color = Color.Cells(1, 1).Interior.ColorIndex
If Not IsNumeric(Color) Then Exit Function
For Each Celda In Rango
If Celda.Interior.ColorIndex = Color Then Total = Total + 1
Next: ContarColor = Total
End Function