Jump to content
ubimur

MACRO QUE CUMPLA CON CONDICIONES

Recommended Posts

Buen día. Quiero hacer una macro que cumpla con ciertos requerimientos: ejemplo,  si el valor de B2 esta entre 40% a 49% y c2 esta entre 0 a 1; entonces D2= rojo 

En el archivo hay dos tablas una de colores donde están los criterios que se deben cumplir para establecer el valor de la celda D (TABLA DE COLORES) y la otra es donde agregan los datos.

La macro se debe ejecutar en diferentes hojas según se cumpla con los criterios establecidos y siempre se utilizaran las columnas B,C y D. En D siempre se coloca la respuesta.

Agradezco de antemano todas sus ayudas y opiniones. Gracias.

 

PORCENTAJE.xlsx

Share this post


Link to post
Share on other sites

Yo tengo esta macro y le coloque los criterios que necesito, pero no la he podido aplicar.

Public Function INVERSION(EMA, EPIP)

Select Case EMA

Case 0.4 To 0.499

Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "rojo"
Case 1.5 To 1.99: INVERSION = "gris"
Case 2 To 2.49: INVERSION = "rosado"
Case 2.5 To 2.99: INVERSION = "amarillo"
Case 3 To 3.49: INVERSION = "blanco"
Case 3.5 To 3.99: INVERSION = "fucsia"
Case 4 To 10: INVERSION = "fucsia"

End Select

Case 0.5 To 0.55

Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "gris"
Case 1.5 To 1.99: INVERSION = "rosado"
Case 2 To 2.49: INVERSION = "amarillo"
Case 2.5 To 2.99: INVERSION = "amarillo"
Case 3 To 3.49: INVERSION = "blanco"
Case 3.5 To 3.99: INVERSION = "blanco"
Case 4 To 10: INVERSION = "fucsia"

End Select

Case 0.5501 To 0.6

Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "gris"
Case 1.5 To 1.99: INVERSION = "amarillo"
Case 2 To 2.49: INVERSION = "amarillo"
Case 2.5 To 2.99: INVERSION = "blanco"
Case 3 To 3.49: INVERSION = "fucsia"
Case 3.5 To 3.99: INVERSION = "azul claro"
Case 4 To 10: INVERSION = "azul oscuro"

End Select

Case 0.601 To 0.65

Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "gris"
Case 1.5 To 1.99: INVERSION = "amarillo"
Case 2 To 2.49: INVERSION = "blanco"
Case 2.5 To 2.99: INVERSION = "fucsia"
Case 3 To 3.49: INVERSION = "fucsia"
Case 3.5 To 3.99: INVERSION = "azul oscuro"
Case 4 To 10: INVERSION = "verde oscuro"

End Select

Case 0.6501 To 0.7

Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "gris"
Case 1.5 To 1.99: INVERSION = "amarilla"
Case 2 To 2.49: INVERSION = "fucsia"
Case 2.5 To 2.99: INVERSION = "azul claro"
Case 3 To 3.49: INVERSION = "azul oscuro"
Case 3.5 To 3.99: INVERSION = "verde oscuro"
Case 4 To 10: INVERSION = "morado"

End Select

Case 0.701 To 0.75

Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "rosado"
Case 1.5 To 1.99: INVERSION = "blanco"
Case 2 To 2.49: INVERSION = "fucsia"
Case 2.5 To 2.99: INVERSION = "azul oscuro"
Case 3 To 3.49: INVERSION = "verde oscuro"
Case 3.5 To 3.99: INVERSION = "morado"
Case 4 To 10: INVERSION = "verde claro"

End Select

Case 0.7501 To 0.8
Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "rosado"
Case 1.5 To 1.99: INVERSION = "blanco"
Case 2 To 2.49: INVERSION = "azul claro"
Case 2.5 To 2.99: INVERSION = "azul oscuro"
Case 3 To 3.49: INVERSION = "morado"
Case 3.5 To 3.99: INVERSION = "verde claro"
Case 4 To 10: INVERSION = "verde claro"

End Select

Case 0.8 To 1
Select Case EPIP

Case 0 To 1: INVERSION = "rojo"
Case 1.01 To 1.49: INVERSION = "rosado"
Case 1.5 To 1.99: INVERSION = "blanco"
Case 2 To 2.49: INVERSION = "azul claro"
Case 2.5 To 2.99: INVERSION = "verde oscuro"
Case 3 To 3.49: INVERSION = "verde claro"
Case 3.5 To 3.99: INVERSION = "verde claro"
Case 4 To 10: INVERSION = "verde claro"

End Select

End Function
 

Share this post


Link to post
Share on other sites

Saludos @ubimur, le realice un minimo cambio a la macro del maestro  @Macro Antonio, simplemente la colocas en el modulo1, y en cada hoja colocas el botón y haces el llamado a la macro

Sub Colorear()
Application.ScreenUpdating = False
For fila = 2 To Range("A" & Rows.Count).End(xlUp).Row
   For x = 3 To Hoja1.Range("G" & Rows.Count).End(xlUp).Row
      If Not Range("B" & fila) > Hoja1.Range("G" & x) Then Exit For
   Next
   For y = 8 To Hoja1.Cells(2, Columns.Count).End(xlToLeft).Column
      If Not Range("C" & fila) > Hoja1.Cells(2, y) Then Exit For
   Next
   Range("D" & fila).Interior.Color = Hoja1.Cells(x, y).Interior.Color

Next
End Sub

en cada hoja quedaria asi

Private Sub CommandButton1_Click()
    Call Colorear
End Sub

suerte

Share this post


Link to post
Share on other sites

Muchas gracias, funciona muy bien. Pero en ese libro me sale el siguiente error:

error del sistema &H80004005 (-2147467259). Error no especificado   

Despues se abren cuatro ventanas y no me deja guardar el libro. Saben como se puede solucionar?.

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png