Como puedo sacar datos hora a hora en access
Tengo una base de datos con las clases de los alumnos, al introducir datos pongo hora de entrada y salida, puede ser hasta cuatro horas, por ejemplo de 10:00 a 14:00
Me gustaría hacer una consulta y me diera que a las 10, 11, 12 y 13 tengo clase con ese alumno
1 respuesta
Sin saber la estructura de tu BD, es prácticamente imposible darte una respuesta exacta.
Suponiendo que tengas en tu tabla un registro para cada alumno, hora y clase de cada día, por ejemplo:
14/12/2015 Juanito 10 matemáticas
14/12/2015 Juanjo 10 inglés
14/12/2015 Juanito 11 ciencias
...
En la consulta has de poner como criterios:
En el campo fecha, la fecha del día actual, con la función Fecha(), o que te pregunte el día a consulta, con esta expresión o similar: [Introduzca una fecha]
Lo mismo harías con el nombre del alumno: [Introduzca el nombre del alumno]
Un saludo.
Un nuevo foro de Access, no dudes en pasarte: http://nksvaccessolutions.com/Foro/
Gracias por tu contestación, intento ser mas conciso, en la base de datos hay una tabla que se llama clases, donde esta relacionada con otras tablas como tipo de alumno, profesores que la imparten, tipo de clase, etc.
Al introducir los datos de la clase, especifico la hora de entrada y hora de salida. Cuando hago la consulta de referencias cruzadas para intentar sacar un horario tipo, me sale la hora de entrada o salida pero no me muestra que ese alumno esta en las horas de en medio.
Te doy las gracias de antemano, de momento no valoro tu respuesta ya que mi pregunta era muy poco clara
No acabo de verlo claro. Como la BD entiendo que tiene datos "protegidos", ¿sería posible que me pusieras un pantallazo de la estructura de la misma (la ventana relaciones) en la que se vean los campos de las tablas, otra imagen del diseño de tu consulta de ref. Cruzadas y un ejemplo de los datos de tu tabla clases?
Así tengo una idea de cómo es tu BD y puedo hacer alguna prueba, a ver si se me ocurre algo.
Un saludo.
Un nuevo foro de Access, no dudes en pasarte: http://nksvaccessolutions.com/Foro/
No me importaría compartir la base de datos y le echas un vistazo, quito los datos, ¿como la envío?
Puedes mandármela comprimida a este correo: [email protected]
Si le pones un par de registros inventados, mejor.
Ya recibí tu archivo, y ando probando cosas. ¿Me podrías enviar (o poner aquí una imagen) una hoja de excel con un ejemplo de cómo quieres el resultado final?
Según datos tendría que salir de esta forma, como un horario normal.
Tu pregunta es complicada, y con los datos tal como los metes en tus tablas, no se puede hacer directamente.
Estoy intentado trabajar con esta idea:
1º/ Crear una tabla auxiliar que se rellenaría con todas las fracciones de hora de cada alumno de cada día, para obtener esto:
Día Hora Alumno Profesor
13/12/15 10:00 Juan Gutierrez Blanco 1
13/12/15 10:30 Juan Gutierrez Blanco 1
13/12/15 11:00 Juan Gutierrez Blanco 1
13/12/15 11:30 Juan Gutierrez Blanco 1
...
2º/ Crear sobre esta tabla la consulta de ref. Cruzadas, que te saldría como quieres.
Dime una cosa: la consulta siempre la lanzarías desde el formulario "fechas", ¿no? Y sería para consultar las clases del profesor seleccionado en el mes que muestra el formulario, ¿correcto?
Pero dame algo de tiempo para prepararte el código que te cree esa consulta, porque casi no tengo tiempo libre estos días.
Si! Lo consulta la haría desde el formulario fechas, pero tengo una duda, esa tabla auxiliar, la tengo que crear y ¿meter manualmente cada registro?
Desde tu experiencia como calificarías la base de datos
Gracias de nuevo
No, la tabla auxiliar la crearías y rellenarías por código, al pulsar en el botón "calendario", y antes de lanzar la consulta. Pero eso me lleva un tiempo programarlo, jejeje.
La BD no me paré en analizarla, fui directo al meollo de la consulta. Además, es bastante extensa como para hacerlo...
¡Gracias!
Ya encontré la forma de hacerlo, y lo más automático que se puede. Te explico cómo tienes que modificar tu BD:
1º/ En tu formulario "Fechas" (o "Fechas 1", el que vayas a usar), quita la macro incrustada que tiene el botón "Calendario" (el botón se llama Comando14) en el evento "Al hacer click", y en su lugar, elige en el desplegable [Procedimiento de evento]. Pulsa en el botoncito con los tres puntos que hay a la derecha de la fila y te llevará al editor de Visual Basic.
Ahora pega, entre las lineas Private Sub Comando14_Click() y End Sub todo este código:
Dim miSQL As String
Dim rst As DAO.Recordset
Dim tablaExiste As Boolean
Dim laHora As Date
Dim qry As Object
Dim qryDef As DAO.QueryDef
Dim i As Integer
'Comprobamos si la tabla THoras existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "THoras" Then
CurrentDb.Execute "DELETE * FROM THoras"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb.Execute "CREATE TABLE THoras (Hora DATE)"
End If
'Y la rellenamos
For i = 10 To 22
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":00"), "hh:nn") & "#)"
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":30"), "hh:nn") & "#)"
Next i
'Comprobamos si la tabla Temp existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "Temp" Then
CurrentDb.Execute "DELETE * FROM Temp"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb. Execute "CREATE TABLE Temp (Alumno STRING, Dia DATE, Hora DATE, Profesor INTEGER)"
End If
'Seleccionas los datos de las tablas, filtrados por los campos del formulario
miSQL = "SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes " _
& "FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id " _
& "WHERE Clases.profesor=" & Me.Profesor & " AND Month([Fecha])=" & Me.numero_Mes & ";"
'Abres los registros
Set rst = CurrentDb.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
MsgBox "No hay datos para mostrar", vbInformation, "SIN DATOS"
GoTo Salida
End If
'Y rellenas la tabla Temp
Do Until rst.EOF
laHora = rst("Hora de inicio")
Do Until laHora = rst("Hora de fin")
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & Format(laHora, "hh:nn") & "#," & rst("Profesor") & ")"
laHora = DateAdd("n", 30, laHora)
Loop
rst.MoveNext
Loop
'Creamos la consulta Auxiliar, borrandola si existe previamente
For Each qry In CurrentData.AllQueries
If qry.Name = "CAux" Then
DoCmd.DeleteObject acQuery, qry.Name
Exit For
End If
Next
Set qryDef = CurrentDb.CreateQueryDef("CAux")
qryDef.SQL = "SELECT Temp.Alumno, Temp.Dia, THoras.Hora, Temp.Profesor " _
& "FROM THoras LEFT JOIN Temp ON THoras.Hora = Temp.Hora " _
& "ORDER BY Temp.Dia, THoras.Hora"
'Creamos la consulta definitiva, borrandola si existe previamente
For Each qry In CurrentData.AllQueries
If qry.Name = "CCalendarioClases" Then
DoCmd.DeleteObject acQuery, qry.Name
Exit For
End If
Next
Set qryDef = CurrentDb.CreateQueryDef("CCalendarioClases")
qryDef.SQL = "TRANSFORM First(CAux.Alumno) AS PrimeroDeAlumno " _
& "SELECT CAux.Hora " _
& "FROM CAux " _
& "GROUP BY CAux.Hora " _
& "PIVOT CAux.Dia"
'Abrimos, por fin, la consulta con el calendario.
DoCmd.OpenQuery "CCalendarioClases"
Salida:
rst.Close
Set rst = Nothing2º/ Guarda los cambios, abre el formulario y pulsa el botón. Te debería salir la consulta tal y como quieres.
Si no te gusta el formato de la hora "hh:mm:ss", puedes cambiarlo si modificas el código la SQL de la consulta de ref. Cruzadas (casi al final del todo), poniendo esto:
qryDef.SQL = "TRANSFORM First(CAux.Alumno) AS PrimeroDeAlumno " _
& "SELECT Format([Hora],"Short Time") AS HoraFormateada " _
& "FROM CAux " _
& "GROUP BY Format([Hora],"Short Time") " _
& "PIVOT CAux.Dia"
Un saludo.
Un nuevo foro de Access ha nacido, visítanos: http://nksvaccessolutions.com/Foro/
Private Sub Comando14_Click()
Dim miSQL As String
Dim rst As DAO.Recordset
Dim tablaExiste As Boolean
Dim laHora As Date
Dim qry As Object
Dim qryDef As DAO.QueryDef
Dim i As Integer
'Comprobamos si la tabla THoras existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "THoras" Then
CurrentDb.Execute "DELETE * FROM THoras"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb.Execute "CREATE TABLE THoras (Hora DATE)"
End If
'Y la rellenamos
For i = 10 To 22
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":00"), "hh:nn") & "#)"
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":30"), "hh:nn") & "#)"
Next i
'Comprobamos si la tabla Temp existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "Temp" Then
CurrentDb.Execute "DELETE * FROM Temp"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb.Execute "CREATE TABLE Temp (Alumno STRING, Dia DATE, Hora DATE, Profesor INTEGER)"
End If
'Seleccionas los datos de las tablas, filtrados por los campos del formulario
miSQL = "SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes " _
& "FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id " _
& "WHERE Clases.profesor=" & Me.Profesor & " AND Month([Fecha])=" & Me.numero_Mes & ";"
'Abres los registros
Set rst = CurrentDb.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
MsgBox "No hay datos para mostrar", vbInformation, "SIN DATOS"
GoTo Salida
End If
'Y rellenas la tabla Temp
Do Until rst.EOF
laHora = rst("Hora de inicio")
Do Until laHora = rst("Hora de fin")
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & Format(laHora, "hh:nn") & "#," & rst("Profesor") & ")"
laHora = DateAdd("n", 30, laHora)
Loop
rst.MoveNext
Loop
'Creamos la consulta Auxiliar, borrandola si existe previamente
For Each qry In CurrentData.AllQueries
If qry.Name = "CAux" Then
DoCmd.DeleteObject acQuery, qry.Name
Exit For
End If
Next
Set qryDef = CurrentDb.CreateQueryDef("CAux")
qryDef.SQL = "SELECT Temp.Alumno, Temp.Dia, THoras.Hora, Temp.Profesor " _
& "FROM THoras LEFT JOIN Temp ON THoras.Hora = Temp.Hora " _
& "ORDER BY Temp.Dia, THoras.Hora"
'Creamos la consulta definitiva, borrandola si existe previamente
For Each qry In CurrentData.AllQueries
If qry.Name = "CCalendarioClases" Then
DoCmd.DeleteObject acQuery, qry.Name
Exit For
End If
Next
Set qryDef = CurrentDb.CreateQueryDef("CCalendarioClases")
qryDef.SQL = "TRANSFORM First(CAux.Alumno) AS PrimeroDeAlumno " _
& "SELECT CAux.Hora " _
& "FROM CAux " _
& "GROUP BY CAux.Hora " _
& "PIVOT CAux.Dia"
'Abrimos, por fin, la consulta con el calendario.
DoCmd.OpenQuery "CCalendarioClases"
Salida:
rst.Close
Set rst = Nothing
End Sub
me pide depurar en esta zona
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & Format(laHora, "hh:nn") & "#," & rst("Profesor") & ")"
primero se me quedo durante 10 min bloqueado y luego me pidió depurar esa parte
Pues a mí me funciona correctamente, no sé por qué a ti no. Te subo el archivo en el que hice las pruebas:
http://www.filebig.net/files/amTU7Duy6x
La contraseña es tu correo.
Si no te funciona, te digo una forma "menos automática" (pero sólo la primera vez) de hacerlo.
no puedo descargar archivo, lo siento
¿Y eso? ¿Te da algún error? A mi me deja sin problemas
se me bloquea el ordenador, sigo intentando descargar tu archivo, que correo pusiste el de me,com o el de gmail,com
yYa lo he conseguido, efectivamente funciona perfectamente
Puede ser que como continuamente trabajo en el desarrollo del programa, y al haber cambiado las tablas y consultas, ese código no me vale?
Te explico un poco el código, para que sepas cómo funciona y lo puedas modificar si modificas las tablas.
1º/ Primero comprueba si existe la tabla THoras. Si existe la vacía y si no existe (la primera vez) la crea. A continuación la rellena con las horas, de las 10 a las 22:30, con las instrucciones del For... Next. Si necesitas cambiar el rango, es ahí donde lo has de hacer.
2º/ Hace lo mismo con la tabla Temp y la rellena con los registros que devuelve esta consulta:
SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id WHERE Clases.profesor=[Forms]![Fecha]![Profesor] AND Month([Fecha])=[Forms]![Fecha]![numero_mes];
Si modificaste las tablas Clases y/o Contactos, has de modificar esta SQL.
3º/ Luego mira si ya existe la consulta CAux, la borra, y la crea de nuevo, con esta SQL:
SELECT Temp.Alumno, Temp.Dia, THoras.Hora, Temp.Profesor FROM THoras LEFT JOIN Temp ON THoras.Hora = Temp.Hora ORDER BY Temp.Dia, THoras.Hora
Como verás, está basada sobre las tablas Temp y THoras.
4º/ Por último, mira si existe la consulta de ref. Cruzadas CCalendarioClases, la borra y la crea, con los datos que devuelve CAux, y que tiene esta SQL:
TRANSFORM First(CAux.Alumno) AS PrimeroDeAlumno SELECT CAux.Hora FROM CAux GROUP BY CAux. Hora PIVOT CAux. Dia;
En definitiva, si modificaste alguna de las tablas que menciono en el punto 2, debes modificar la SQL de esa consulta en el código, pero manteniendo los nombres de los campos, para no tener que modificar las siguientes SQLs.
Gracias por tu información y ayuda, has abierto una nueva e inmensa ventana de posibilidades para el futuro de mis proyectos, tengo programas hechos para muchas cosas del trabajo y vida personal, con código todo es más fácil y posible.
Por otro lado, he hecho una comprobación con el archivo que tu me has enviado, te rogaría lo hicieses tu, en la tabla clases mete muchos registros, yo tengo de momento unos 170, pero cada día se generarán muchos mas, podrás comprobar que al meter muchos registros, y realizar la consulta Calendario se ralentiza tanto, en mi caso me toca apagar directamente para reiniciar.
Espero tus comentarios, gracias de nuevo
Te respondo sin probar, porque no tengo tiempo (ni ganas de meter un montón de registros...)
Haz una copia de tu BD (para comprobar que funciona), en la que tengas ya creadas las consultas CAux y CCalendarioClases, y cambia el código por este otro:
Dim miSQL As String
Dim rst As DAO.Recordset
Dim tablaExiste As Boolean
Dim laHora As Date
Dim qry As Object
Dim qryDef As DAO.QueryDef
Dim i As Integer
'Comprobamos si la tabla THoras existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "THoras" Then
CurrentDb.Execute "DELETE * FROM THoras"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb.Execute "CREATE TABLE THoras (Hora DATE)"
End If
'Y la rellenamos
For i = 10 To 22
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":00"), "hh:nn") & "#)"
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":30"), "hh:nn") & "#)"
Next i
'Comprobamos si la tabla Temp existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "Temp" Then
CurrentDb.Execute "DELETE * FROM Temp"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb. Execute "CREATE TABLE Temp (Alumno STRING, Dia DATE, Hora DATE, Profesor INTEGER)"
End If
'Seleccionas los datos de las tablas, filtrados por los campos del formulario
miSQL = "SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes " _
& "FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id " _
& "WHERE Clases.profesor=" & Me.Profesor & " AND Month([Fecha])=" & Me.numero_Mes & ";"
'Abres los registros
Set rst = CurrentDb.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
MsgBox "No hay datos para mostrar", vbInformation, "SIN DATOS"
GoTo Salida
End If
'Y rellenas la tabla Temp
Do Until rst.EOF
laHora = rst("Hora de inicio")
Do Until laHora = rst("Hora de fin")
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & Format(laHora, "hh:nn") & "#," & rst("Profesor") & ")"
laHora = DateAdd("n", 30, laHora)
Loop
rst.MoveNext
Loop
'Abrimos, por fin, la consulta con el calendario.
DoCmd.OpenQuery "CCalendarioClases"
Salida:
rst.Close
Set rst = NothingSi ya tienes creadas las tablas THoras y Temp (al pulsar el botón una vez) y no las borras, aún puedes simplificarlo más:
Dim miSQL As String
Dim rst As DAO.Recordset
Dim qry As Object
Dim qryDef As DAO.QueryDef
Dim i As Integer
Dim laHora As Date
'Vacias la tabla Temp existe.
CurrentDb.Execute "DELETE * FROM Temp"
'Seleccionas los datos de las tablas, filtrados por los campos del formulario
miSQL = "SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes " _
& "FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id " _
& "WHERE Clases.profesor=" & Me.Profesor & " AND Month([Fecha])=" & Me.numero_Mes & ";"
'Abres los registros
Set rst = CurrentDb.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
MsgBox "No hay datos para mostrar", vbInformation, "SIN DATOS"
GoTo Salida
End If
'Y rellenas la tabla Temp
Do Until rst.EOF
laHora = rst("Hora de inicio")
Do Until laHora = rst("Hora de fin")
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & Format(laHora, "hh:nn") & "#," & rst("Profesor") & ")"
laHora = DateAdd("n", 30, laHora)
Loop
rst.MoveNext
Loop
'Abrimos, por fin, la consulta con el calendario.
DoCmd. OpenQuery "CCalendarioClases"
Salida:
Rst. Close
Set rst = Nothing
no tengo las consultas creadas, las tablas si
Las creo?
Me he tomado la libertad de crearlas con el código que me enviaste, y una vez creado he insertado el último código para crear Calendario, el mas abreviado, y ha vuelto a bloquearse.
Cuando cierro la BD de forma forzada, luego reinicio, reparo la base de datos, veo que las tablas creadas Temp tienen 600.000 registros, numero literal, no una exageración
Se repiten infinitamente los registros, ¿puede sea un error en el código?
Si fuera un error de código también se te tenían que repetir con pocos datos...
Realmente no creo que se dupliquen los registros, pero te parece que lo hace por la expresión con la que se crea el campo Alumno (que he sacado de tus consultas originales, por ejemplo "Clases por día 2"):
SiInm(EsNulo([Apellidos]);SiInm(EsNulo([Nombre]);[Club];[Nombre]);SiInm(EsNulo([Nombre]);[Apellidos];[Apellidos] & ", " & [Nombre]))
Ten en cuenta también que es normal que tarde, porque tiene que crear todos los registros intermedios entre la hora inicial y la final de cada alumno que tenga el profesor en el mes, y si tienes muchos registros, se puede hacer largo el proceso.
Intenta "aligerarlo" añadiendo antes del rst.moveNext la linea:
DoEvents
Yo más no le puedo hacer...
No creo que sea un proceso lento, has visto el número de registros! 3 millones
estoy haciendo pruebas con tu archivo, voy metiendo de uno en uno los registros en clases para saber en qué número se colapsa..., pero entiendo lo dejes ya, es muy complicado y no merece la pena.
Gracias
Date cuenta que por cada hora de clase de un alumno tiene que crear dos registros en la tabla Temp. En el ejemplo que te mandé, con un profesor, 3 alumnos (registros en "clases") y 5,5 horas de clase en total, te crea 11 registros en temp (2 x 5,5).
Si en tu mes tienes tienes, por ejemplo, 500 horas de clase, te creará 1000 registros, y así.
Lo que veo raro es que te cree tantos registros...
Pregunta, si ejecutas esta consulta, con el formulario Fechas abierto con un profesor seleccionado ¿cuántos registros te devuelve? :
SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id WHERE Clases.profesor=[Forms]![Fecha]![Profesor] AND Month([Fecha])=[Forms]![Fecha]![numero_mes];
voy a mirar
en principio sale la información correcta
salen 38 registros por ejemplo en diciembre y 55 en noviembre
Pues no es normal que te genere tantos registros el código...
si metes tu 7 registros veras como se colapsa
Ok, el problema es que a veces coge no sólo la hora, sino también una fecha, y es dónde se vuelve loco el programa.
Solución, para el código largo (que se ejecuta bastante rápido):
Private Sub Comando14_Click()
Dim miSQL As String
Dim rst As DAO.Recordset
Dim tablaExiste As Boolean
Dim laHora As String
Dim laHoraFin As String
Dim qry As Object
Dim qryDef As DAO.QueryDef
Dim i As Integer
Dim j As Integer
'Comprobamos si la tabla THoras existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "THoras" Then
CurrentDb.Execute "DELETE * FROM THoras"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb.Execute "CREATE TABLE THoras (Hora DATE)"
End If
'Y la rellenamos
For i = 10 To 22
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":00"), "hh:nn") & "#)"
CurrentDb.Execute "INSERT INTO THoras VALUES(#" & Format(CDate(i & ":30"), "hh:nn") & "#)"
Next i
'Comprobamos si la tabla Temp existe. Si existe la vaciamos
tablaExiste = False
For Each tbl In CurrentData.AllTables
If tbl.Name = "Temp" Then
CurrentDb.Execute "DELETE * FROM Temp"
tablaExiste = True
End If
Next tbl
'Si no, la creamos
If tablaExiste = False Then
CurrentDb. Execute "CREATE TABLE Temp (Alumno STRING, Dia DATE, Hora DATE, Profesor INTEGER)"
End If
'Seleccionas los datos de las tablas, filtrados por los campos del formulario
miSQL = "SELECT IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Apellidos] & ', ' & [Nombre])) AS Alumno, Clases.Fecha, Clases.[Hora de inicio], Clases.[Hora de fin], Clases.profesor, Month([Fecha]) AS Mes " _
& "FROM Clases INNER JOIN Contactos ON Clases.Alumno = Contactos.Id " _
& "WHERE Clases.profesor=" & Me.Profesor & " AND Month([Fecha])=" & Me.numero_Mes & ";"
'Abres los registros
Set rst = CurrentDb.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
MsgBox "No hay datos para mostrar", vbInformation, "SIN DATOS"
GoTo Salida
End If
'Y rellenas la tabla Temp
Do Until rst.EOF
laHora = Format(rst("Hora de inicio"), "hh:nn")
laHoraFin = Format(rst("Hora de fin"), "hh:nn")
'Do Until laHora = laHoraFin
If Right(laHora, 2) = 30 Then
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & laHora & "#," & rst("Profesor") & ")"
laHora = Format(Left(laHora, 2) + 1, "00") & ":00"
End If
For i = Left(laHora, 2) To Left(laHoraFin, 2)
For j = 0 To 30 Step 30
CurrentDb.Execute "INSERT INTO Temp VALUES('" & rst("Alumno") & "',#" & Format(rst("Fecha"), "mm/dd/yyyy") _
& "#,#" & Format(i, "00") & ":" & Format(j, "00") & "#," & rst("Profesor") & ")"
Next j
Next i
'Loop
rst.MoveNext
Loop
'Creamos la consulta Auxiliar, borrandola si existe previamente
For Each qry In CurrentData.AllQueries
If qry.Name = "CAux" Then
DoCmd.DeleteObject acQuery, qry.Name
Exit For
End If
Next
Set qryDef = CurrentDb.CreateQueryDef("CAux")
qryDef.SQL = "SELECT Temp.Alumno, Temp.Dia, THoras.Hora, Temp.Profesor " _
& "FROM THoras LEFT JOIN Temp ON THoras.Hora = Temp.Hora " _
& "ORDER BY Temp.Dia, THoras.Hora"
'Creamos la consulta definitiva, borrandola si existe previamente
For Each qry In CurrentData.AllQueries
If qry.Name = "CCalendarioClases" Then
DoCmd.DeleteObject acQuery, qry.Name
Exit For
End If
Next
Set qryDef = CurrentDb.CreateQueryDef("CCalendarioClases")
qryDef.SQL = "TRANSFORM First(CAux.Alumno) AS PrimeroDeAlumno " _
& "SELECT CAux.Hora " _
& "FROM CAux " _
& "GROUP BY CAux.Hora " _
& "PIVOT CAux.Dia"
'Abrimos, por fin, la consulta con el calendario.
DoCmd.OpenQuery "CCalendarioClases"
Salida:
rst.Close
Set rst = Nothing
End SubSi prefieres acortarlo, vete comparando lso anteriores para hacerlo. La diferencia está en el bucle Do Until rst.EOF, ahora en vez de trabajar con fechas (horas), trabajo con cadenas de texto con formato hora, y parece que funciona.
Saludos. Svein
Ahora si genera la consulta de inmediato
Pero los datos no son correctos, creo es por la consulta en si, yo creo existen conflictos de coincidencia de horas, por ejemplo si alguien esta de 14 a 14.30 y otro de 14:30, al coincidir en las 14:30, salen datos aleatorios
Creo se puede solucionar si a la hora de fin se le resta un segundo, no?
Ese "error" es por el propio diseño de la consulta de refs. Cruzadas. Los campos que van en la intersección de filas y columnas, sólo aceptan funciones agregadas (suma, max, min, primero, ultimo...) por lo que no puedes tener dos valores distintos para una misma hora.
Dependiendo de cómo tengas los horarios, te saldrá bien o no...
Entonces es imposible sacar esos datos, ¿aunque sea con otro tipo de consulta?
No se me ocurre la manera de hacerlo, lo siento.
Único que pruebes a hacerlo por alumno y/o asignatura...
Lo he resuelto con una consulta sencilla
PARAMETERS [Forms]![Calendario]![Profesor] Value;
TRANSFORM Min(IIf(IsNull([Apellidos]),IIf(IsNull([Nombre]),[Club],[Nombre]),IIf(IsNull([Nombre]),[Apellidos],[Nombre] & " " & [Apellidos]))) AS [Archivar como]
SELECT Horario.Hora
FROM Horario, Contactos INNER JOIN Clases ON Contactos.Id = Clases.Alumno
WHERE (((Horario.Hora) Is Not Null And (Horario.Hora) Between [Hora de inicio] And [Hora de Fin] And (Horario.Hora)<>[Hora de Fin]) AND ((Clases.Profesor)=[Forms]![Calendario]![Profesor]))
GROUP BY Horario.Hora
ORDER BY Clases.Fecha DESC
PIVOT Clases.Fecha;
Me alegra un montón que lo hayas solucionado, y más aún que compartas la solución.
Un saludo y feliz año!
