Bienvenido a la mayor comunidad de usuarios EXCEL

Regístrate ahora y podrás: / 💪 Hacer preguntas a los expertos / ⬇️ Descargar ejemplos y plantillas / 🏅 Acceder a contenidos premium

Regístrate gratis

completar macro fecha estática

jmsc24

Member
Buenas, copio y pego una macro que me introduce fecha estática cuando introduzco un dato. Funciona bien. Lo que ocurre es que cuando borro un dato y se queda la celda de origen vacia en la celda destino (AQ) también me pone la FECHA y quiero:

Que cuando la modificación sea BORRAR CONTENIDO de las celdas del rango de origen (AL4: AM38) me borre la fecha estática en la celda destino, es decir que si en el rango origen no hay datos no ponga fecha Y NO LO TOME COMO CAMBIO.

Que debería añadir, no sé programar macros. Gracias.

La macro es la siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.MoveAfterReturn = False

If Target.Count = 1 Then

If Not Intersect(Target, Range("AL4:AM38")) Is Nothing Then

Cells(Target.Row, "AQ") = Now

End If
End If
End Sub
 
Última edición:
Solución
Código:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AA4:AM38")) Is Nothing Then
   If Not Intersect(Target, Range("AJ" & Target.Row).DirectPrecedents) Is Nothing Then
      If Range("AJ" & Target.Row) = "" Then
         Range("AM" & Target.Row) = ""
      Else
         Range("AM" & Target.Row) = Date
      End If
   End If
End If
Application.EnableEvents = True
End Sub

jmsc24

Member
Código:
If Not Intersect(Target, Range("AL4:AM38")) Is Nothing Then
   If Target = "" then
      Cells(Target.Row, "AQ") =""
   Else
      Cells(Target.Row, "AQ") = Now
   End If
End If

No sera suficiente con un If Cells(x,y) = "" then Cells(i,j)="" else Cells(i,j)= Now

Saludos.
Gracias por contestar, al final uso una que añadio el compañero Antoni, que si funcionó. Saludos.
 

jmsc24

Member
Las fórmulas no provocan el evento Change, es necesario ver el archivo para analizar las fórmulas.
Hola Antoni, te adjunto un trozdo del excel, lo que le afecta, ya que el libro dice que es grande aun comprimido. El rango origen AJ4:AJ38 (QUE TIENE FORMULA), y el de destino AM4:AM38.Saludos y gracias de antemano.
 

Adjuntos

  • excel foro.xlsx
    16,5 KB · Visitas: 3

Antoni

Well-known member
Código:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AA4:AM38")) Is Nothing Then
   If Not Intersect(Target, Range("AJ" & Target.Row).DirectPrecedents) Is Nothing Then
      If Range("AJ" & Target.Row) = "" Then
         Range("AM" & Target.Row) = ""
      Else
         Range("AM" & Target.Row) = Date
      End If
   End If
End If
Application.EnableEvents = True
End Sub
 
Última edición:

jmsc24

Member
Código:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AA4:AM38")) Is Nothing Then
   If Not Intersect(Target, Range("AJ" & Target.Row).DirectPrecedents) Is Nothing Then
      If Range("AJ" & Target.Row) = "" Then
         Range("AM" & Target.Row) = ""
      Else
         Range("AM" & Target.Row) = Date
      End If
   End If
End If
Application.EnableEvents = True
End Sub
Gracias! Funciona! Como puedo puntuarte?
 

jmsc24

Member
Código:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AA4:AM38")) Is Nothing Then
   If Not Intersect(Target, Range("AJ" & Target.Row).DirectPrecedents) Is Nothing Then
      If Range("AJ" & Target.Row) = "" Then
         Range("AM" & Target.Row) = ""
      Else
         Range("AM" & Target.Row) = Date
      End If
   End If
End If
Application.EnableEvents = True
End Sub

Con saber que ha funcionado, es suficiente. :)
Eres un crack amigo! Mi mayor de las suertes para ti, por tu buen hacer! Saludos desde Cádiz.
 

jmsc24

Member
Eres un crack amigo! Mi mayor de las suertes para ti, por tu buen hacer! Saludos desde Cádiz.
Hola Antoni de nuevo:

Intento crear una macro similar con otro rango, la funcion es la misma que la otra. Quiero que esten las dos a la vez. Le doy a INSERTAR MODULO y no me parece WORKSHEET CHANGE. No se como hacerlo. Te adjunto la hoja. La macro es exactamente esta, es igual que la otra con rangos diferentes:


Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Not Intersect(Target, Range("AA4:AH38")) Is Nothing Then
If Not Intersect(Target, Range("AJ" & Target.Row).DirectPrecedents) Is Nothing Then
If Range("AJ" & Target.Row) = "" Then
Range("AL" & Target.Row) = ""
Else
Range("AL" & Target.Row) = Now

End If
End If
End If
 

Adjuntos

  • SOLES MARZO21.xlsm
    181,9 KB · Visitas: 1

Antoni

Well-known member
El evento Worksheet_Change va a nivel de hoja/libro y es ÚNICO por cada objeto, por lo que hay que contemplar el nuevo rango dentro del mismo procedimiento. En cualquier caso no entiendo que es lo que quieres hacer.
¿Que se supone que quieres añadir a lo que hay?.
 

jmsc24

Member
El evento Worksheet_Change va a nivel de hoja/libro y es ÚNICO por cada objeto, por lo que hay que contemplar el nuevo rango dentro del mismo procedimiento. En cualquier caso no entiendo que es lo que quieres hacer.
¿Que se supone que quieres añadir a lo que hay?.
Antoni, pues quiero otra celda donde se ponga otra fecha estatica igual. La celda de destino es AL, la de origen es AJ que incorpora una formula que incorpora formula donde esta involucrado el rango AA4:AH38. Lo mismo que la otra macro, se trata de otra informacion de fecha estática ligada a una formula. La macro tomada indivudualmente es la misma que la anterior, con celdas diferentes. Espero haberme explicado. Gracias por tu respuesta y tu ayuda.
 

jmsc24

Member
hola Antoni, necesito tu ayuda:

Voy poner fecha estatica donde la celda origen no tiene formula. el rango origen es AI4:AI38. Si introduzco dato en ese rango quiero salga fecha estática en AL. Pongo esta que funciono anteriormente pero no me vale (a lo mejor esta celda origen tenia formula pero no lo recuerdo). A ver si detectas fallo. Muchas gracias de antemano:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Ai4:Ai38")) Is Nothing Then
If Target = "" Then
Cells(Target.Row, "AL") = ""
Else
Cells(Target.Row, "AL") = Now
End If
End If
End Sub
 

Temas similares

Arriba