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

Respuesta
2

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 Sub

Saludos.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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas