Tengo este código en Visual basic para Excel, y no me funciona.

El código es el siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)

'Por.jom
uf = Range("H" & Rows.Count).End(xlUp).Row
If Target.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Then Exit Sub
If Target = "" Then
Target.Interior.ColorIndex = xlNone
Exit Sub
End If
If Not Intersect(Target, Range("L11:BK" & uf)) Is Nothing Then
For j = Target.Column - 1 To Range("L1").Column Step -1
If Cells(Target.Row, j) <> "" Then
If Target - Cells(Target.Row, j) > Cells(Target.Row, "H") Then
Target.Interior.ColorIndex = 46 'Naranja
Else
Target.Interior.ColorIndex = 43 'Verde
End If
Exit For
End If
Next
End If

ut = Range("I" & Rows.Count).End(xlUp).Row
If Not IsDate(Target) Then Exit Sub
If Target = "" Then
Target.Interior.ColorIndex = xlNone
Exit Sub
End If
If Not Intersect(Target, Range("L10:BK" & ut)) Is Nothing Then
For l = Target.Column - 1 To Range("L1").Column Step -1
If Cells(Target.Row, l) <> "" Then
If Target - Cells(Target.Row, l) > Cells(Target.Row, "I") Then
Target.Interior.ColorIndex = 21
Else
Target.Interior.ColorIndex = 24
End If
Exit For
End If
Next
End If

ug = Range("E" & Rows.Count).End(xlUp).Row
If Target = "" Then
Target.Interior.ColorIndex = xlNone
Exit Sub
End If
If Not Intersect(Target, Range("L9:BK" & ug)) Is Nothing Then
For k = Target.Column - 1 To Range("L1").Column Step -1
If Cells(Target.Row, k) = "PREVISTA" Then
Target.Interior.ColorIndex = 4
Else
If Cells(Target.Row, k) = "REALIZADA" Then
Target.Interior.ColorIndex = 6
Else
If Cells(Target.Row, k) = "REPLANTEADA" Then
Target.Interior.ColorIndex = 11
End If
End If
Exit For
End If
Next
End If
End Sub

Sub todas()
'Por.Jorge Ortega
Dim Res As Integer
Res = MsgBox("Esta operación puede durar varios segundos." & vbCrLf & "En cada máquina, el primer dato anual quedará en blanco." & vbCrLf & "Los siguientes quedarán en verde, si las horas no pasan del máximo establecido," & vbCrLf & " y en naranja si pasan del máximo establecido." & vbCrLf & "¿Deseas continuar?", 4 + 32 + 256)
If Res = vbYes Then
Application.ScreenUpdating = False
uf = Range("H11").SpecialCells(xlLastCell).Row
Range("L11:BK" & uf).Interior.ColorIndex = xlNone
Range("L11:BK" & uf).Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
For Each Celda In Selection
Celda.Value = Celda
Next
End If
Range("L11").Select
End Sub

--------------------------------------------------------------------------

La primera parte de "uf", funciona bien

La segunda y la tercera no

En la segunda, si la fecha que se pone en esa fila, está entre la fecha de la columna "I" y7 días posteriores, la celda se pinta de verde, si no se pinta de rosa.

Si no hay nada, en blanco.

En la tercera parte, cada palabra corresponde a un color distinto, sin hay nada, en blanco.

Con el otro SUB de abajo, se ejecutaría todo de forma manual.

Dime si necesitas el archivo.

Respuesta
1

Podes enviarme tu libro o por lo menos la hoja donde se trabaja con la macro... con todas las aclaraciones que puedas.

Podés copiar mi corre desde mi sitio o 'armarlo' así: cibersoft_arg ARROBA yahoo.com.ar

Sdos

Elsa

¡Gracias! Te envío el libro.

Así te debe quedar la macro. Luego lo podrás comprobar en tu libro que ya te lo estoy enviando.

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.jom - arreglada x Elsamatilde
If Target.Count > 1 Then Exit Sub
'en cualquiera de las 3 filas, si es vacío se quita color y finaliza
If Target = "" Then
    'Target.Interior.ColorIndex = xlNone
    Exit Sub
End If
'si es numérico se trata de la fila 3
If IsNumeric(Target) Then
    uf = Range("H" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("L11:BK" & uf)) Is Nothing Then
        For j = Target.Column - 1 To Range("L1").Column Step -1
            If Cells(Target.Row, j) <> "" Then
                If Target - Cells(Target.Row, j) > Cells(Target.Row, "H") Then
                    Target.Interior.ColorIndex = 46 'Naranja
                Else
                    Target.Interior.ColorIndex = 43 'Verde
                End If
                Exit For
            End If
        Next
    End If
'si es fecha se trata de fila 2
ElseIf IsDate(Target) Then
    ut = Range("I" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("L10:BK" & ut)) Is Nothing Then
        For l = Target.Column - 1 To Range("L1").Column Step -1
            If Cells(Target.Row, l) <> "" Then
                If Target - Cells(Target.Row, l) > Cells(Target.Row, "I") Then
                    Target.Interior.ColorIndex = 21
                Else
                    Target.Interior.ColorIndex = 24
                End If
                Exit For
            End If
        Next
    End If
'sino es texto y corresponde a la fila 1
Else
    ug = Range("E" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("L9:BK" & ug)) Is Nothing Then
        For k = Target.Column - 1 To Range("L1").Column Step -1
            If Cells(Target.Row, k) = "PREVISTA" Then
                Target.Interior.ColorIndex = 4
            ElseIf Cells(Target.Row, k) = "REALIZADA" Then
                Target.Interior.ColorIndex = 6
            ElseIf Cells(Target.Row, k) = "REPLANTEADA" Then
                Target.Interior.ColorIndex = 11
            End If
            Exit For
        Next
    End If
End If
End Sub

Las instrucciones que deben ejecutarse en todas las filas las dejé al inicio así no se repiten.

También observá en el último grupo el uso de If.....ElseIf ....End If

Con respecto a la macro para el reseteo va comentada en el libro.

Sdos

Elsa

¡Muchas Gracias por todo! 

El código, definitivamente ha quedado ajustado a las necesidades que tenía.

Recibe un cordial saludo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas