Otro vez macro formato condicional (color)

Apreciado amigo:
El pasado 16 de abril te hice una pregunta sobre el tem de referencia y obtuve tu rápida y brillante respuesta que, vuelvo a reproducir, más abajo.
Sin embargo, aplicando la macro que verás más abajo: consigo que me identifique los formatos condicionales de la selección efectuada pero me copia y pega la linea de esa celda aunque no se cumpla la condición impuesta en el formato condicional, porque me parece que lo único que hace la macro es identificar que a la celda se le ha asignado un formato condicional pero no verifica si se esta cumpliendo y -claro está- me pega todas las celdas, aunque no lo coumplan.
Espero haberme explicado con la suficiente claridad, ruego me contestes a la mayor brevedad (como es habitual en ti) dado que me urge mucho.
Una vez más, gracias.
HANS.
Aquí te pongo la macro:
Public Sub Copiarporcolorfondoformatocondicionalbuena()
'********En esta macro selecciona toda la fila y la copia en la hoja 2
Dim c As Range
Dim Co As Integer, y As Integer
For Each c In Selection
If c.Interior.ColorIndex = 3 Then
Co = Co + 1
c.EntireRow.Copy
Worksheets("Hoja2").Select
Worksheets("Hoja2").Cells(Co, 1).Select
Worksheets("Hoja2").Paste
ElseIf c.FormatConditions.Count > 0 Then
For y = 1 To c.FormatConditions.Count
If c.FormatConditions(y).Interior.ColorIndex = 3 Then
Co = Co + 1
c.EntireRow.Copy
Worksheets("Hoja2").Select
Worksheets("Hoja2").Cells(Co, 1).Select
Worksheets("Hoja2").Paste
Exit For
End If
Next
End If
Next c
End Sub

1 Respuesta

Respuesta
1
Parece que no era tan fácil.
Tenés razón, considera Verdadera la condición siempre.
Agregué una comparación de condiciones y puse algunas sentencias en procedimientos para tratar de hacerlo más legible.
Public Sub Copiarporcolorfondoformatocondicionalbuena()
'********En esta macro selecciona toda la fila y la copia en la hoja 2
Dim c As Range
Dim Co As Integer, y As Integer
Dim resp As Boolean
For Each c In Selection
If c.Interior.ColorIndex = 3 Then
Co = Co + 1
Call pega_celdas(c.Worksheet.Name, c.Address, "Hoja2", Co)
ElseIf c.FormatConditions.Count > 0 Then
For y = 1 To c.FormatConditions.Count
If c.FormatConditions(y).Interior.ColorIndex = 3 Then
If (c.FormatConditions(y).Operator = xlBetween Or c.FormatConditions(y).Operator = xlNotBetween) Then
resp = CumpleCondicion(c.Worksheet.Name, c.Address, c.FormatConditions(y).Operator, c.FormatConditions(y).Formula1, c.FormatConditions(y).Formula2)
Else
resp = CumpleCondicion(c.Worksheet.Name, c.Address, c.FormatConditions(y).Operator, c.FormatConditions(y).Formula1, 0)
End If
If resp = True Then
Co = Co + 1
Call pega_celdas(c.Worksheet.Name, c.Address, "Hoja2", Co)
Exit For
End If '** resp
End If '** c.formatcond
Next '** y
End If '** c.interior.colorindex
Next c
End Sub
'****************
Sub pega_celdas(hoja1 As String, celda As String, hoja2 As String, Nrocelda2 As Integer)
Sheets(hoja1).Range(celda).EntireRow.Copy
Worksheets(hoja2).Select
Worksheets(hoja2).Cells(Nrocelda2, 1).Select
Worksheets(hoja2).Paste
End Sub
'****************
Function CumpleCondicion(hoja1 As String, celda As String, op As Integer, f1 As Integer, f2 As Integer) As Boolean
CumpleCondicion = False
Select Case op
Case xlBetween: If Worksheets(hoja1).Range(celda).Value >= f1 And Worksheets(hoja1).Range(celda).Value >= f2 Then CumpleCondicion = True
Case xlNotBetween: If Not (Worksheets(hoja1).Range(celda).Value >= f1 And Worksheets(hoja1).Range(celda).Value >= f2) Then CumpleCondicion = True
Case xlEqual: If Worksheets(hoja1).Range(celda).Value = f1 Then CumpleCondicion = True
Case xlNotEqual: If Not (Worksheets(hoja1).Range(celda).Value = f1) Then CumpleCondicion = True
Case xlGreater: If Worksheets(hoja1).Range(celda).Value > f1 Then CumpleCondicion = True
Case xlLess: If Worksheets(hoja1).Range(celda).Value < f1 Then CumpleCondicion = True
Case xlGreaterEqual: If Worksheets(hoja1).Range(celda).Value >= f1 Then CumpleCondicion = True
Case xlLessEqual: If Worksheets(hoja1).Range(celda).Value <= f1 Then CumpleCondicion = True
End Select
End Function
Lo probé y funciona.
Suerte.
Apreciado amigo:
Gracias por tu esfuerzo y rapidez.
He intentado ejecutar lo que me has enviado y me dice:
Se ha producido el error "13" en tiempo de ejecución:
No coinciden los tipos.
Cuando depuro, aparece resaltada en amarillo la "frase" siguiente:
resp = CumpleCondicion(c.Worksheet.Name, c.Address, c.FormatConditions(y).Operator, c.FormatConditions(y).Formula1, 0)
Te reproduzo la macro hasta esa línea para que te sea fácil localizarla (como verás, a la macro le cambié el nombre):
Public Sub CopiarporcolorfondoformatocondicionalFINALcumplecondicion()
'********En esta macro selecciona toda la fila y la copia en la hoja 2
Dim c As Range
Dim Co As Integer, y As Integer
Dim resp As Boolean
For Each c In Selection
If c.Interior.ColorIndex = 3 Then
Co = Co + 1
Call pega_celdas(c.Worksheet.Name, c.Address, "Hoja2", Co)
ElseIf c.FormatConditions.Count > 0 Then
For y = 1 To c.FormatConditions.Count
If c.FormatConditions(y).Interior.ColorIndex = 3 Then
If (c.FormatConditions(y).Operator = xlBetween Or c.FormatConditions(y).Operator = xlNotBetween) Then
resp = CumpleCondicion(c.Worksheet.Name, c.Address, c.FormatConditions(y).Operator, c.FormatConditions(y).Formula1, c.FormatConditions(y).Formula2)
Else
resp = CumpleCondicion(c.Worksheet.Name, c.Address, c.FormatConditions(y).Operator, c.FormatConditions(y).Formula1, 0)
Seguro que se trata de una tontería, pero soy incapaz de determinar qué es lo que estoy haciendo mal.
Una vez más: HELP, MY FRIEND!
Un abrazo,
Hans.
Hans :
Volqué el código que te había remitido antes en una nueva planilla . Puse algunas celdas en la hoja1 con el Color 3 (Colorado) y un formato condicional (si el contenido de la celdas es mayor a 5, pone color 3) y funciono sin errores.
¿Cuál es tu condición para el Formato Condicional?.
Uso Excel 97 (Office 97) sobre Windows 98.
Mi dirección de e-mail es [email protected].
¿Podrías mandarme el archivo -o parte del mismo- zipeado? .
Quiero ver si es un problema de versión .
El problema de "tipo" era porque la función "CumpleCondicion" esperaba un entero y no una cadena ( por Fórmula con referencia a otra celda).
Tuve que ajustar la función a esta circunstancia, usando una variable intemedia.
Pero además, parece que el "Each Cell" no quiere trabajar como corresponde con FormatConditions (y fórmula) porque se queda haciendo referencia a celda de la primer celda del rango. Ej si el rango es a10.. a20, la condición apunta a B10 siempre.
Eso me hizo tomar una decisión. Cambiar FOR EACH por 2 FOR NEXT.
Quedó así :
Public Sub CopiarporcolorfondoformatocondicionalFINALcumplecondicion()
'********En esta macro selecciona toda la fila y la copia en la hoja 2
Dim Co As Integer, y As Integer
Dim resp As Boolean
Dim fila1 As Long, fila2 As Long, fila As Long
Dim colu1 As Integer, colu2 As Integer, colu As Integer
Dim CHcolu As String
Dim hoja1 As String
fila1 = Selection.Cells(1).Row
fila2 = Selection.Cells(Selection.Count).Row
colu1 = Selection.Cells(1).Column
colu2 = Selection.Cells(Selection.Count).Column
hoja1 = Selection.Worksheet.Name
For colu = colu1 To colu2
CHcolu = Chr(64 + colu)
For fila = fila1 To fila2
Range(CHcolu & fila).Select
If ActiveCell.Interior.ColorIndex = 3 Then
Co = Co + 1
Call pega_celdas(ActiveCell.Worksheet.Name, ActiveCell.Address, "Hoja2", Co)
ElseIf ActiveCell.FormatConditions.Count > 0 Then
For y = 1 To ActiveCell.FormatConditions.Count
If ActiveCell.FormatConditions(y).Interior.ColorIndex = 3 Then
If (ActiveCell.FormatConditions(y).Operator = xlBetween Or ActiveCell.FormatConditions(y).Operator = xlNotBetween) Then
resp = CumpleCondicion(ActiveCell.Worksheet.Name, ActiveCell.Address, ActiveCell.FormatConditions(y).Operator, ActiveCell.FormatConditions(y).Formula1, ActiveCell.FormatConditions(y).Formula2)
Else
resp = CumpleCondicion(ActiveCell.Worksheet.Name, ActiveCell.Address, ActiveCell.FormatConditions(y).Operator, ActiveCell.FormatConditions(y).Formula1, "0")
End If
If resp = True Then
Co = Co + 1
Call pega_celdas(ActiveCell.Worksheet.Name, ActiveCell.Address, "Hoja2", Co)
' Exit For
End If '** resp
End If '** c.formatcond
Next '** y
End If '** c.interior.colorindex
Next fila
Next colu
End Sub
'****************
Sub pega_celdas(hoja1 As String, celda As String, hoja2 As String, Nrocelda2 As Integer)
Sheets(hoja1).Range(celda).EntireRow.Copy
Worksheets(hoja2).Select
Worksheets(hoja2).Cells(Nrocelda2, 1).Select
Worksheets(hoja2).Paste
Worksheets(hoja1).Select
End Sub
'****************
Function CumpleCondicion(hoja1 As String, celda As String, op As Integer, f1 As String, f2 As String) As Boolean
Dim F1BIS
F1BIS = Worksheets(hoja1).Range(Right(f1, Len(f1) - 1)).Value
CumpleCondicion = False
Select Case op
Case xlBetween: If Worksheets(hoja1).Range(celda).Value >= F1BIS And Worksheets(hoja1).Range(celda).Value >= f2 Then CumpleCondicion = True
Case xlNotBetween: If Not (Worksheets(hoja1).Range(celda).Value >= F1BIS And Worksheets(hoja1).Range(celda).Value >= f2) Then CumpleCondicion = True
Case xlEqual: If Worksheets(hoja1).Range(celda).Value = F1BIS Then CumpleCondicion = True
Case xlNotEqual: If Not (Worksheets(hoja1).Range(celda).Value = F1BIS) Then CumpleCondicion = True
Case xlGreater: If Worksheets(hoja1).Range(celda).Value > F1BIS Then CumpleCondicion = True
Case xlLess: If Worksheets(hoja1).Range(celda).Value < F1BIS Then CumpleCondicion = True
Case xlGreaterEqual: If Worksheets(hoja1).Range(celda).Value >= F1BIS Then CumpleCondicion = True
Case xlLessEqual: If Worksheets(hoja1).Range(celda).Value <= F1BIS Then CumpleCondicion = True
End Select
End Function
Parecía que iba a ser más simple ¿no?.
Suerte.
Federico:
Muchas gracias de nuevo: cada día demuestras tu buen saber hacer y tu alto grado de profesionalidad y compromiso.
Ha funcionado a las mil maravillas: yo también creí que sería más fácil, me has dado una lección magistral.
Un abrazo,
Hans.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Macro con formato condicional

Antes que nada, agradeceros a todos los expertos en general y a ti en particular vuestra labor, profesionalidad y acierto en todas las consultas que os venimos haciendo. He estado siguiendo las respuestas que diste para crear una macro que identifica...
1 respuesta

Como ocultar filas a través del valor de una celda

¿Tengo una tabla en la cual donde necesito que: cuando a1 sea igual a 0 oculte el rango a1:c3; y de igual forma si a4 fuera igual a 0, oculte el rango b4:c7. Para ello necesito que se ejecute la macro automáticamente, sin necesidad de incrporarle un...
1 respuesta

Arrojar varios datos desde un criterio de búsqueda

Lo que necesito es: Yo tengo una columna (A1) con varios nombres de "Clientes", estos en algunos casos están repetidos y al frente en B1 tienen un # que es la factura de un producto "X", lo que quiero es buscar cualquier cliente en una celda de otra...
3 respuestas

Copiar datos de una columna a otra hoja

Primero que todo felicidades por la pagina muy bonita. La pregunta es esta en mi hoja 1 capturo como 20 datos en la columna b1 hasta b20 y con un botón mandarlos a la hoja 2 que es mi base de datos solamente que en la fila 1 tengo los títulos y deseo...
2 respuestas

Saber el color de una celda con formato condicional

Tengo una hoja excel con una serie de celdas con formatos condicionales, de tal forma que si ocurre algo que es un error, la celda se colorea en ROJO. Al ser la hoja muy grande, había pensado hacer una macro que revisara toda la hoja en el evento...
2 respuestas

Macro que se ejecute cuando cambia un valor

Tengo un archivo de excel con 2 hojas (hoja1 y hoja2) En la hoja2, hice un código para que se ejecute una macro automáticamente cada que cambien los valores de una celda la D11. Si cambian el valor de esta celda, y le ponen un 0 necesito que me...
1 respuesta

Buscar dentro de matriz excel

Tengo una matriz de datos de m*m con las distancias de puntos( coordenadas). Necesito buscar aquellas coordenadas que la distancia sea menos a 200 ycopiar las coordenadas a otra hoJa.
1 respuesta

Formularios VBA en excel

Estoy realizando un directorio y quisiera que a la hora de introducir mis datos en el formulario que ya he realizado me los clasifique en las distintas hojas que he creado para cada sector pero que tambien se quede registrado en la hoja principal que...
1 respuesta

"VLOOKUP" la segunda y la tercera coincidencia

Buscando un dato con "VLOOKUP" me da la primera coincidencia pero tiene 3 coincidencias como pedir la segunda y la tercera
1 respuesta

Excel copiar datos a otra hoja en fila vacia para Dam

Quiero copiar datos de una determinada columna (hoja1) a hoja 2 ya tengo echo el procedimiento lo único malo que al copiarlo me los copia en la misma fila, que instrucción me falta para que pase a la siguiente fila El código es este : Sub copiar()...
4 respuestas