Reto para productividad en mantenimiento de vehículos

Ante todo, muchas gracias por tu tiempo.

El planteamiento es el siguiente:
Datos:
- Rango “K12:BJ12” (cada celda corresponde a un nº
de la semana)
- Celda “G12” (corresponde a un tope de horas, por
ejemplo 400)
- “n” (nº de horas que está funcionando un coche)
Descripción:
En una celda del rango “K12:BJ12”, se introduce un número
“n” ó se puede quedar en blanco si esa semana ha estado parado el coche.
Cuando se ejecute la macro tiene que pintar las celdas de
ese rango, a razón de cuatro criterios:
1.
Dejarla en blanco si en la celda de ese rango no
se han marcado horas, es decir, que no tenga datos.
2.
Dejarla en blanco si es la primera del rango en
la que apuntamos horas, bien sea K12, L12, etc.
3.
Pintarla de naranja, si la diferencia entre un
marcaje de horas y el anterior de ese rango, (estén en las celdas que estén),
es mayor ó igual a la celda G12.
4.
Pintarla de verde, si la diferencia entre un
marcaje de horas y el anterior de ese rango, (estén en las celdas que estén),
es menor a la celda G12.


Todo esto se repite en el mismo rango de columnas pero cada 3 filas, es decir:
Rango “K15:BJ15”, con la celda “G15” como referencia de horas.
Rango “K18:BJ18”, con la celda “G18” como referencia de horas.
Etc.
Y tiene como tope la fila 350.

1 Respuesta

Respuesta
1

Para realizar lo que pides, te preparé una macro. Que funciona en automático cada vez que introduzcas un valor en el rango “K12:BJ” y hasta la última fila que tengas datos en la columna G.
Sigue las Instrucciones para poner la macro en worksheet
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
4. Del lado derecho copia la macro

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
uf = Range("G" & Rows.Count).End(xlUp).Row
If Target.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Then Exit Sub
If Not Intersect(Target, Range("K12:BJ" & uf)) Is Nothing Then
    For j = Target.Column - 1 To Range("K1").Column Step -1
        If Cells(Target.Row, j) <> "" Then
            If Target - Cells(Target.Row, j) >= Cells(Target.Row, "G") Then
                Target.Interior.ColorIndex = 46 'Naranja
            Else
                Target.Interior.ColorIndex = 4 'Verde
            End If
            Exit For
        End If
    Next
End If
End Sub

La macro se activa para cada dato nuevo que pongas en tu tabla, si quieres que se actualicen los colores con los valores que ya tienes, presiona F2 en cada celda y luego enter, para que la macro trabaje y ponga un color; después la macro funcionará en automático.
Los colores que lleva la macro son un verde y un naranja, en excel cada color se identifica con un número, si los colores no te gustan, escoge el color que te guste en el siguiente enlace.
http://dmcritchie.mvps.org/excel/colors.htm
Identifica el número que corresponde al color que te gusta y cámbialo en la macro en esta parte
If Target - Cells(Target.Row, j) >= Cells(Target.Row, "G") Then
Target.Interior.ColorIndex = 46 'Naranja
Else
Target.Interior.ColorIndex = 4 'Verde
End If

Saludos. DAM
Si es lo que necesitas.

Hola.

Dos cosillas. Primero, cuando no hay ningún dato en la celda, esta se tiene que quedar en blanco.

Y segundo, ¿Hay alguna forma de que la macro corra de principio a fin modificando los colores, sin tener que hacer lo del F2 celda por celda?; Lo digo porque son muchas celdas. Gracias y un saludo.

Cosilla 1. Cambia la macro por esta

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
uf = Range("G" & Rows.Count).End(xlUp).Row
If Target.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Then Exit Sub
If Target = "" Then Exit Sub
If Not Intersect(Target, Range("K12:BJ" & uf)) Is Nothing Then
    For j = Target.Column - 1 To Range("K1").Column Step -1
        If Cells(Target.Row, j) <> "" Then
            If Target - Cells(Target.Row, j) >= Cells(Target.Row, "G") Then
                Target.Interior.ColorIndex = 46 'Naranja
            Else
                Target.Interior.ColorIndex = 4 'Verde
            End If
            Exit For
        End If
    Next
End If
End Sub

Cosilla 2. Después de poner la macro anterior. Ejecuta esta macro

Sub todas()
'Por.DAM
uf = Range("G12").SpecialCells(xlLastCell).Row
Range("K12:BJ" & uf).Interior.ColorIndex = xlNone
For Each celda In Range("K12:BJ" & uf)
    celda.Value = celda
Next
End Sub

Saludos.DAM
Si es lo que necesitas.

Hola.

La macro, aunque un poco lenta, cumple perfectamente los objetivos, pero me pregunto si es posible lo siguiente.

- Si borras una cifra que está en verde o naranja, se queda pintada, cuando al carecer de datos debería de ponerse en blanco.

-Si introduces una cifra, dentro de la misma fila no debería dejar si es menor que las de la izquierda, ya que las horas no pueden disminuir. ¿Es posible corregirlo?

Perdón por las puntualizaciones, pero de verdad que con lo que me has facilitado ya me has ayudado mucho.

Gracias y un saludo,

Podrías finalizar esta pregunta y crear una nueva por cada petición.

Saludos. DAM

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas