Ayuda con macro
Hola dam. Necesito que me ayudes con un macro. Necesito que en el comienzo me solicite ingresar el año (que es solo un nro nada mas eje: 2012) e ingresarlo en la celda D1. Después de eso que me reemplace la palabra Lunes, martes, miércoles, jueves , viernes y sábados, por la celda D1 (osea por el "2012" (numero ingresado en la celda D1).
Este es el macro:
_______ codigo_______
Sub Cambiardias()
' Cambia días por 2012
Cells.Replace What:="Lunes", Replacement:="2012", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Martes", Replacement:="2012", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Miércoles", Replacement:="2012", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Jueves", Replacement:="2012", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Viernes", Replacement:="2012", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Sábado", Replacement:="2012", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Reemplaza I y O que es entrada y salida, por 1 y 2
Cells.Replace What:="I", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="O", Replacement:="2", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' elimima fila 1 y columna deja formato num
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.NumberFormat = "0"
' Mueve la columna de E&S a primer lugar
Columns("C:C").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
'divide la columna fecha-hora en 2 columnas separadas
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(8, 2)), TrailingMinusNumbers:=True
MsgBox "Se realizaron los cambios"
End Sub
Te cambio la macro
Sub Cambiardias()
anio = InputBox("Ingresa el año")
Range("D1") = anio
' Cambia días por 2012
Cells.Replace What:="Lunes", Replacement:=Range("D1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Martes", Replacement:=Range("D1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Miércoles", Replacement:=Range("D1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Jueves", Replacement:=Range("D1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Viernes", Replacement:=Range("D1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Sábado", Replacement:=Range("D1"), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Reemplaza I y O que es entrada y salida, por 1 y 2
Cells.Replace What:="I", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="O", Replacement:="2", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' elimima fila 1 y columna deja formato num
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.NumberFormat = "0"
' Mueve la columna de E&S a primer lugar
Columns("C:C").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
'divide la columna fecha-hora en 2 columnas separadas
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(8, 2)), TrailingMinusNumbers:=True
MsgBox "Se realizaron los cambios"
End SubSaludos.Dam
