Para DANTE AMOR una Macro que identifique si una Fecha Especifica y una Hora especifica ya esta agendada
Tengo un Excel con 2 hojas. Una llamada INGRESAR DATOS y otra llamada AGENDA.
En la Hoja INGRESAR DATOS ingreso los datos de Fecha, Hora y Paciente. Luego de ingresarlos, ejectuto una MACRO llamada GRABAR que translada dichos datos a la segunda hoja llamada AGENDA y los organiza cronológicamente. Se regresa a la hoja INGRESAR DATOS y borrar los datos que se habian ingresado y allí acaba la MACRO en espera de ingresar una nueva fecha, hora y paciente.
Hasta ahi todo va muy bien el inconveniente es que no hay ninguna advertencia de agendar a varios pacientes a una misma fecha y hora lo cual puede ser perjudicial pues no hay forma de atender a dos o mas pacientes a la misma hora.
Es por ello que seria interesante que la macro ANTES DE grabar el paciente en la hoja AGENDA, pudiera de alguna manera verificar si ya esa fecha y hora se encuentra ocupada pues a esa fecha y hora ya hay un paciente previamente agendando.
La idea es que esa macro al analizar eso, si encuentra que ya hay un paciente previamente agendado a esa fecha y hora, me dejara elegir, si aún así quiero agendar al nuevo paciente, de esta manera quedarian agendados 2 pacientes a la misma fecha y hora ó me permite cancelar la operación y evitar asi que 2 pacientes queden agendados a la misma fecha y hora.
Ojalá me puedas colaborar.
1 Respuesta
Me puedes enviar tu archivo con ejemplos. Si ya tienes macros o formularios, dime cómo funcionan.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario y el título de esta pregunta.
Avísame en esta pregunta cuando me lo hayas enviado.
Por otra parte te comento, para llevar un mejor control de citas, revisa utilizar el calendario de outlook, en esa herramienta puedes almacenar citas, tener alarmas, puedes obtener reportes por día, por semana, por mes.
El calendario de outlook está diseñado para hacer citas, llevar una agenda, etc. Mientras que en Excel puedes llevar ese control pero tendrás que desarrollar con macros, con fórmulas, etc, todo lo que vayas necesitando.
Puedes revisarlo y ver si cubre tus necesidades, no está demás, aprender algo nuevo.
Si no es lo que necesitas, puedo revisar tu archivo y preparar la macro.
Saludos. Dante Amor
Listo Dante ya te acabo de enviar el correo con el archivo y te explique todo lo que me dijiste. Muchas gracias por tu interés.
Te anexo la macro modificada.
Sub GrabarCita()
'Mod. Por.Dante Amor
' GrabarCita Macro
Dim fec As Date
'
Application.ScreenUpdating = False
Set h1 = Sheets("Ingreso")
Set h2 = Sheets("Agenda")
'
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
fec = h1.[E3]
ho1 = h1.[E4]
ho2 = h1.[E5]
grabar = False
'
Set r = h2.Columns("A")
Set b = r.Find(fec)
If b Is Nothing Then
grabar = True
Else
grabar = True
ncell = b.Address
Do
f = b.Row
w1 = h2.Cells(b.Row, "B")
w2 = h2.Cells(b.Row, "C")
If ho1 >= h2.Cells(b.Row, "B") And ho2 <= h2.Cells(b.Row, "C") Then
res = MsgBox("Ya existe un paciente en ese horario" & vbCr & vbCr & _
"Presiona ''SI'' para borrar y poner en su lugar la nueva cita" & vbCr & _
"Presiona ''No'' para escribir la nueva cita en una fila nueva" & vbCr & _
"Presiona ''Cancelar'' para cancelar la operación", _
vbYesNoCancel, "REGISTRAR CITA")
'
Select Case res
Case vbYes
grabar = True
u = b.Row
Case vbNo
grabar = True
Case vbCancel
grabar = False
End Select
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
'
If grabar Then
h1.Range("E3:E6").Copy
h2.Range("A" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
With h2.Sort
.SortFields.Clear
.SortFields.Add Key:=h2.Range("A2:A" & u), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange h2.Range("A1:D" & u)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
h1.Range("E3:E6").ClearContents
h1.Range("E3").Select
End If
MsgBox "fin"
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
Hola Dante
Muchas gracias !
Solo quería saber si se podrán corregir 2 fallas que le encontré.
1. Que cuando agregue la nueva cita, me la organice en forma ascendente como fecha (ya esta) pero también por hora, así no me la va a poner de ultima del día así sea más temprana que la ultima que estaba resgitrada.
2. Hice una prueba de que pasaría si ya había una cita de 10 a 10:20 y otra de 10:20 a 10:40. Y luego no me percatara que esas dos ya existían es decir que el horario de 10 a 10:40 ya estaba ocupado con 2 citas y fuera a hacer una cita nueva de 10:00 a 10:40 y pensé que me iba a decir que ya existían citas pero NO lo hizo, no se si eso se pueda arreglar.
Espero tu respuesta
Disculpa, te envío la corrección para el punto 1.
Cambia esta línea
If ho1 >= h2.Cells(b.Row, "B") And ho2 <= h2.Cells(b.Row, "C") Then
Por esta:
If ho1 >= h2.Cells(b.Row, "B") And ho1 <= h2.Cells(b.Row, "C") Then
Prueba nuevamente y me comentas. Si todo está bien, recuerda valorar la respuesta.
En cuanto a ordenar por hora e identificar las citas que están programadas (punto 2), no estaban en tu pregunta original. Con gusto te sigo ayudando pero deberás valorar esta respuesta y crear una nueva por cada petición.
