Macro que busque en una tabla organizada Cronológicamente la visita anterior a la actual de un cliente

Tengo la siguiente solicitud. Tengo una hoja llamada "INGRESAR_CITA" en la cual en la celda "D6" registro el ID de un cliente.

Ya tengo una macro que lo que hace es buscarme los datos de ese cliente en una hoja llamada "Base" y si los encuentra me trae dichos datos. Pero a esa macro quiero ahora adicionarle lo siguiente.

Tengo otra hoja llamada "Agenda" en la cual están registradas las citas que cada cliente ha agendando en el transcurso del tiempo. Lo que quisiera entonces al ejecutar esa macro que me busca los datos del cliente de la hoja "Base" que después de buscarme esos datos verifique cuando fue la última cita registrada para ese cliente en la hoja "AGENDA" y cuando lo encuentre en un msgbox me saque el siguiente mensaje "El paciente anteriormente tuvo una cita agendada para (Aquí pondríamos lo que aparezca en la columna "N" de agenda). Dicha cita el paciente: (Aquí ponemos lo que aparezca en la columna "V" de agenda).

En caso que el paciente anteriormente no halla agendado ninguna cita es decir en Agenda no aparezca, entonces la macro termina.

Lo importante aquí es que la orden de la hoja "Agenda" no sea alterado pues dicha hoja esta organizada cronológicamente en fechas de la más antigua a la más reciente y en horas de la cita dada más temprano a la cita dada más tarde. Es por eso que el orden de la hoja "Agenda" no se puede alterar.

La macro actual que busca los datos del paciente es esta:

Sub Buscar2()
'Por.Dante Amor
    Set h2 = Sheets("BASE")
    Set h3 = Sheets("INGRESAR_CITA")
    h3.[D8:D24].ClearContents
    '
    If h3.[D6] = "" Then
        MsgBox "Número de Identificación VACIO." & vbCrLf & "" & vbCrLf & "Por favor escriba el número de Identificación en el espacio correspondiente.", vbExclamation
        [D6].Select
        Exit Sub
    End If
    '
    Set b = h2.Columns("C").Find(h3.[D6], lookat:=xlWhole)
    If Not b Is Nothing Then
        h3.[D8] = h2.Cells(b.Row, "B")
        h3.[D9] = h2.Cells(b.Row, "C")
        h3.[D10] = h2.Cells(b.Row, "D")
        h3.[D11] = h2.Cells(b.Row, "E")
        h3.[D12] = h2.Cells(b.Row, "F")
        h3.[D13] = h2.Cells(b.Row, "G")
        h3.[D14] = h2.Cells(b.Row, "H")
        h3.[D15] = h2.Cells(b.Row, "I")
        h3.[D16] = h2.Cells(b.Row, "J")
        h3.[D17] = h2.Cells(b.Row, "K")
        h3.[D18] = h2.Cells(b.Row, "L")
        h3.[D19] = h2.Cells(b.Row, "M")
        DeleteFiltroAvanzado
        BuscaUltimasCitas
    Else
        MsgBox "El número de Identificación no existe en la BASE DE DATOS." & vbCrLf & "" & vbCrLf & "Si es PACIENTE NUEVO por favor continúe en las siguientes celdas registrando sus datos." & vbCrLf & "" & vbCrLf & "Si es PACIENTE ANTIGUO por favor verifique con el PACIENTE el número de Identificación e Intentelo de nuevo.", vbExclamation
        Temp1
        anoymeses
        Range("D8").Select
    End If
End Sub

1 Respuesta

Respuesta
1

H o l a:

Te anexo la macro actualizada

Sub Buscar2()
'Por.Dante Amor
    Set h2 = Sheets("BASE")
    Set h3 = Sheets("INGRESAR_CITA")
    Set h4 = Sheets("AGENDA")
    h3.[D8:D24].ClearContents
    '
    If h3.[D6] = "" Then
        MsgBox "Número de Identificación VACIO." & vbCrLf & "" & vbCrLf & "Por favor escriba el número de Identificación en el espacio correspondiente.", vbExclamation
        [D6].Select
        Exit Sub
    End If
    '
    Set b = h2.Columns("C").Find(h3.[D6], lookat:=xlWhole)
    If Not b Is Nothing Then
        h3.[D8] = h2.Cells(b.Row, "B")
        h3.[D9] = h2.Cells(b.Row, "C")
        h3.[D10] = h2.Cells(b.Row, "D")
        h3.[D11] = h2.Cells(b.Row, "E")
        h3.[D12] = h2.Cells(b.Row, "F")
        h3.[D13] = h2.Cells(b.Row, "G")
        h3.[D14] = h2.Cells(b.Row, "H")
        h3.[D15] = h2.Cells(b.Row, "I")
        h3.[D16] = h2.Cells(b.Row, "J")
        h3.[D17] = h2.Cells(b.Row, "K")
        h3.[D18] = h2.Cells(b.Row, "L")
        h3.[D19] = h2.Cells(b.Row, "M")
        DeleteFiltroAvanzado
        BuscaUltimasCitas
    Else
        MsgBox "El número de Identificación no existe en la BASE DE DATOS." & vbCrLf & "" & vbCrLf & "Si es PACIENTE NUEVO por favor continúe en las siguientes celdas registrando sus datos." & vbCrLf & "" & vbCrLf & "Si es PACIENTE ANTIGUO por favor verifique con el PACIENTE el número de Identificación e Intentelo de nuevo.", vbExclamation
        temp1
        anoymeses
        Range("D8").Select
    End If
    'Buscar la última cida
    Set b = h4.Columns("F").Find(h3.[D6], lookat:=xlWhole, SearchDirection:=xlPrevious)
    If Not b Is Nothing Then
        MsgBox "El paciente anteriormente tuvo una cita agendada para: " & h4.Cells(b.Row, "N") & _
               ". Dicha cita el paciente: " & h4.Cells(b.Row, "V")
    End If
End Sub

'

S a l u d o s

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas