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.
1 respuesta
¡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 SubLas 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.
