Sustituir una fórmula por macros
Alguien me podría ayudar para sustituir esta fórmula por macros. Se los agradecería mucho. Gracias por su ayuda.
=SI(FECHA(AÑO(HOY()),COINCIDIR(NOMPROPIO($B$2),{"Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto","Septiembre","Octubre","Noviembre","Diciembre"},0),FILA()-FILA($B$2))>FECHA(AÑO(HOY()),COINCIDIR(NOMPROPIO($B$2),{"Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto","Septiembre","Octubre","Noviembre","Diciembre"},0)+1,1)-1,"",FECHA(AÑO(HOY()),COINCIDIR(NOMPROPIO($B$2),{"Enero","Febrero","Marzo","Abril","Mayo","Junio","Julio","Agosto","Septiembre","Octubre","Noviembre","Diciembre"},0),FILA()-FILA($A$2)))
1 respuesta
Pon la siguiente macro en los eventos de tu hoja
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Address(False, False) <> "A2" Then Exit Sub
Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 3).ClearContents
elmes = 0
'mes = LCase(Range("A2").Value)
mes = LCase(Target.Value)
If Target.Value = "" Then Exit Sub
For i = 1 To 12
m = LCase(Format(DateSerial(Year(Date), i, 1), "mmmm"))
If m = mes Then
elmes = i
Exit For
End If
Next
'
If elmes = 0 Then
MsgBox "El nombre del mes no es correcto"
Exit Sub
End If
'
k = 3
For d = 1 To Day(DateSerial(Year(Date), elmes + 1, 1) - 1)
Cells(k, "A") = DateSerial(Year(Date), elmes, d)
Cells(k, "A").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
k = k + 1
Next
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Buen día amigo Dante, hize lo que me dijiste pero no me funciono, copie la macro a la hoja y al ejecutarla no me aparece la macro, te mando la imagen, la segunda imagen es donde yo escribo en la celda B2 el nombre del mes(puede ser cualquier mes del año) y en B3:B33 me muestra todas las fechas del mes. es parecido a la que me creaste de sábados y domingos pero la diferencia de esta es que debe ser para todos los días.
trate de modificar la macro de sábados y domingos para adaptarla a esta, pero no me funciono.
Atte.
Luis Enrique
Cambia la macro por esta:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Address(False, False) <> "B2" Then Exit Sub
Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row + 3).ClearContents
elmes = 0
mes = LCase(Target.Value)
If Target.Value = "" Then Exit Sub
For i = 1 To 12
m = LCase(Format(DateSerial(Year(Date), i, 1), "mmmm"))
If m = mes Then
elmes = i
Exit For
End If
Next
'
If elmes = 0 Then
MsgBox "El nombre del mes no es correcto"
Exit Sub
End If
'
k = 3
For d = 1 To Day(DateSerial(Year(Date), elmes + 1, 1) - 1)
Cells(k, "B") = DateSerial(Year(Date), elmes, d)
Cells(k, "B").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
k = k + 1
Next
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Gracias amigo dante quedo perfectamente con la macro modificada y abusando de tu ayuda como quedaría la macro si yo quisiera que me mostrara nada más los días Lunes a Viernes de cada mes, lo que pasa que trabajo con 4 listas como esas pero con diferentes horarios.
Atentamente.
Luis Enrique
Te anexo el cambio
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Address(False, False) <> "B2" Then Exit Sub
Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row + 3).ClearContents
elmes = 0
mes = LCase(Target.Value)
If Target.Value = "" Then Exit Sub
For i = 1 To 12
m = LCase(Format(DateSerial(Year(Date), i, 1), "mmmm"))
If m = mes Then
elmes = i
Exit For
End If
Next
'
If elmes = 0 Then
MsgBox "El nombre del mes no es correcto"
Exit Sub
End If
'
k = 3
For d = 1 To Day(DateSerial(Year(Date), elmes + 1, 1) - 1)
dia = Weekday(DateSerial(Year(Date), elmes, d))
Select Case dia
Case 2, 3, 4, 5, 6
Cells(k, "B") = DateSerial(Year(Date), elmes, d)
Cells(k, "B").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
k = k + 1
End Select
Next
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias! Nuevamente por tu ayuda amigo Dante, me sirvió de muchísimo las macros que me creaste. Saludos
Atentamente.
Luis Enrique
