Ayuda macro
Hola como estas
Necesito de tu ayudita
Con este programita soy principiendo en esto disculpa tanta molestia
1. Que al momento de seleccionar la ACCIÓN esta me la arrojé en la casilla C14 y así sucesivamente es decir la siguiente acción C 15 luego C16 ETC.
2.Que la fecha se tome la del sistema pero que no me borre las que tengo almacenacenada y al igual del icono de acción la primera fecha la coloque en la casilla D14 y la siguiente en la D15 luego C16
y por ultimo que cuando de el icono refrescar me borre desde la casilla A14 así abajo
envío link http://www.megaupload.com/?d=W0FLSZP4
gracias por tu colaboración
cordialmente
Necesito de tu ayudita
Con este programita soy principiendo en esto disculpa tanta molestia
1. Que al momento de seleccionar la ACCIÓN esta me la arrojé en la casilla C14 y así sucesivamente es decir la siguiente acción C 15 luego C16 ETC.
2.Que la fecha se tome la del sistema pero que no me borre las que tengo almacenacenada y al igual del icono de acción la primera fecha la coloque en la casilla D14 y la siguiente en la D15 luego C16
y por ultimo que cuando de el icono refrescar me borre desde la casilla A14 así abajo
envío link http://www.megaupload.com/?d=W0FLSZP4
gracias por tu colaboración
cordialmente
1 respuesta
Respuesta de Isaac Reyes
1
Aquí te dejo las tres macros.
Te recomiendo que revises el código y leas los comentarios.
Saludos, espero que sea lo que requieres.
Sub refrescar()
'Desproteger la hoja
ActiveSheet. Unprotect
'Setear el valor de la primera fila
'La primera fila es 14, pero antes de ocupar el valor se le suma 1
'esa es la razón del numero 13
ActiveSheet.Cells(1, "AA") = 13
'Seleccionar el rango a borrar
Range("B14:G163").Select
Selection.ClearContents 'Borrar
'Volver a la primera celda para rellenar
Range("B14").Select
'Volver a bloquear la hoja
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub actividad()
'Sacamos el valor ya guardado en AA1, si no hay un valor, le asignamos 14
'Es como la función SI()
fila = IIf(CLng("0" + ActiveSheet.Cells(1, "AA")) < 14, _
14, ActiveSheet.Cells(1, "AA"))
'Selecciona la celda en que debe quedar el texto
ActiveSheet.Cells(fila, "C").Select
ActiveCell.FormulaR1C1 = "=+VLOOKUP(Hoja2!R1C1,Hoja2!R2C1:R17C3,3)"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Next.Activate
End Sub
Sub tiempo()
'Sacamos el valor ya guardado en AA1, si no hay un valor, le asignamos 14
'Es como la función SI()
nuevaFila = IIf(ActiveSheet.Cells(1, "AA") = "", _
14, ActiveSheet.Cells(1, "AA"))
ActiveSheet.Unprotect 'Desprotejo para poder escribir
If ActiveSheet.Cells(nuevaFila, "B") <> "" _
And ActiveSheet.Cells(nuevaFila, "E") = "" Then
'Guardamos el nuevo valor
Range(ActiveSheet.Cells(nuevaFila, "E").Address).Select 'seleccionamos la celda
ActiveCell.FormulaR1C1 = "=+NOW()"
'Asignar la diferencia en minutos
'ActiveSheet.Cells(nuevaFila, "D") = DateDiff("s", _
ActiveSheet.Cells(nuevaFila, "B"), _
ActiveSheet.Cells(nuevaFila, "E"))
Else
'Incrementar fila
nuevaFila = nuevaFila + 1
'Guardamos el nuevo valor
ActiveSheet.Cells(1, "AA") = nuevaFila
'Guardar la fecha en D
ActiveSheet.Cells(nuevaFila, "D").NumberFormat = "m/d/yyyy"
ActiveSheet.Cells(nuevaFila, "D") = Date
'Guardamos el nuevo valor
Range(ActiveSheet.Cells(nuevaFila, "B").Address).Select 'seleccionamos la celda
ActiveCell.FormulaR1C1 = "=+NOW()"
End If
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm:ss"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveCell.Next.Activate
End Sub
Te recomiendo que revises el código y leas los comentarios.
Saludos, espero que sea lo que requieres.
Sub refrescar()
'Desproteger la hoja
ActiveSheet. Unprotect
'Setear el valor de la primera fila
'La primera fila es 14, pero antes de ocupar el valor se le suma 1
'esa es la razón del numero 13
ActiveSheet.Cells(1, "AA") = 13
'Seleccionar el rango a borrar
Range("B14:G163").Select
Selection.ClearContents 'Borrar
'Volver a la primera celda para rellenar
Range("B14").Select
'Volver a bloquear la hoja
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub actividad()
'Sacamos el valor ya guardado en AA1, si no hay un valor, le asignamos 14
'Es como la función SI()
fila = IIf(CLng("0" + ActiveSheet.Cells(1, "AA")) < 14, _
14, ActiveSheet.Cells(1, "AA"))
'Selecciona la celda en que debe quedar el texto
ActiveSheet.Cells(fila, "C").Select
ActiveCell.FormulaR1C1 = "=+VLOOKUP(Hoja2!R1C1,Hoja2!R2C1:R17C3,3)"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Next.Activate
End Sub
Sub tiempo()
'Sacamos el valor ya guardado en AA1, si no hay un valor, le asignamos 14
'Es como la función SI()
nuevaFila = IIf(ActiveSheet.Cells(1, "AA") = "", _
14, ActiveSheet.Cells(1, "AA"))
ActiveSheet.Unprotect 'Desprotejo para poder escribir
If ActiveSheet.Cells(nuevaFila, "B") <> "" _
And ActiveSheet.Cells(nuevaFila, "E") = "" Then
'Guardamos el nuevo valor
Range(ActiveSheet.Cells(nuevaFila, "E").Address).Select 'seleccionamos la celda
ActiveCell.FormulaR1C1 = "=+NOW()"
'Asignar la diferencia en minutos
'ActiveSheet.Cells(nuevaFila, "D") = DateDiff("s", _
ActiveSheet.Cells(nuevaFila, "B"), _
ActiveSheet.Cells(nuevaFila, "E"))
Else
'Incrementar fila
nuevaFila = nuevaFila + 1
'Guardamos el nuevo valor
ActiveSheet.Cells(1, "AA") = nuevaFila
'Guardar la fecha en D
ActiveSheet.Cells(nuevaFila, "D").NumberFormat = "m/d/yyyy"
ActiveSheet.Cells(nuevaFila, "D") = Date
'Guardamos el nuevo valor
Range(ActiveSheet.Cells(nuevaFila, "B").Address).Select 'seleccionamos la celda
ActiveCell.FormulaR1C1 = "=+NOW()"
End If
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm:ss"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveCell.Next.Activate
End Sub
