Función que convierte cualquier carácter a texto puramente ASCII (Access VBA)
19/03/2023¿Mis procedimientos tienen tratamiento de errores?
21/03/2023
Function sMedian(sCampo As String, sTabla As String, Optional sDonde As String) As Double
'----------------------------------------------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/vba-moda-mediana-y-algo-mas
'----------------------------------------------------------------------------------------------------------------------------------------------
' Título : sMedian
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve la mediana de los valores de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'---------------------------------------------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'----------------------------------------------------------------------------------------------------------------------------------------------
' Retorno : Double
'----------------------------------------------------------------------------------------------------------------------------------------------
' Test: : Para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copiar el bloque siguiente al
' portapapeles y pega en el editor de VBA. Descomentar la línea que nos interese y pulsar F5 para ver su funcionamiento.
'
' Sub sMedian_test()
' Dim mediana
'
' mediana = sMedian("campo", "tabla")
' Debug.Print "La mediana es: " & mediana
'
' End Sub
'-----------------------------------------------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim sSql As String
Dim NumReg As Long
Dim Valor1 As Double
Dim sTbl As String
Dim sFld As String
sTbl = wzBracketString(sTabla, 1)
sFld = wzBracketString(sCampo, 1)
sMedian = False
On Error GoTo sMedian_Error
sSql = "SELECT " & sFld & " FROM " & sTbl & " ORDER BY " & sFld
If Trim(sDonde) & "" <> "" Then
sSql = sSql & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(sSql, dbOpenDynaset)
If Rs.RecordCount > 0 Then
Rs.MoveLast
NumReg = Rs.RecordCount
If NumReg Mod 2 = 1 Then 'Es impar.
Rs.MoveFirst
Rs.Move NumReg / 2
sMedian = Rs(sFld)
Else ' Es par.
Rs.MoveFirst
Rs.Move NumReg / 2
Valor1 = Rs(sFld)
Rs.MovePrevious
sMedian = (Valor1 + Rs(sFld)) / 2
End If
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sMedian_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sMedian del Módulo modAggDom"
End Function
Function sModa(sCampo As String, sTabla As String, Optional sDonde As String) As Double
'----------------------------------------------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/vba-moda-mediana-y-algo-mas
'----------------------------------------------------------------------------------------------------------------------------------------------
' Título : sModa
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve la moda de los valores de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'---------------------------------------------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'----------------------------------------------------------------------------------------------------------------------------------------------
' Retorno : Dble
'----------------------------------------------------------------------------------------------------------------------------------------------
' Test: : Para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copiar el bloque siguiente al
' portapapeles y pega en el editor de VBA. Descomentar la línea que nos interese y pulsar F5 para ver su funcionamiento.
'
' Sub sModa_test()
' Dim moda
'
' moda = sModa("campo", "tabla")
' Debug.Print "La moda es: " & moda
'
' End Sub
'-----------------------------------------------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
Dim sTbl As String
Dim sFld As String
sTbl = wzBracketString(sTabla, 1)
sFld = wzBracketString(sCampo, 1)
On Error GoTo sModa_Error
MiSQL = "SELECT " & sFld & vbCrLf & _
" FROM (SELECT " & sFld & ", Count(" & sFld & ") AS Frecuencia FROM " & sTbl & " GROUP BY " & sFld
If Trim(sDonde) & "" <> "" Then
MiSQL = MiSQL & " HAVING " & sDonde
End If
MiSQL = MiSQL & ") AS Datos_Frecuencia " & vbCrLf & _
"WHERE frecuencia = (SELECT MAX(Frecuencia) FROM (SELECT numero, Count(numero) AS Frecuencia FROM test GROUP BY numero));"
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sModa = Null
Else
Rs.MoveFirst
sModa = Rs(sFld)
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sModa_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sModa del Módulo modAlbaStats"
End Function
2 Comments
Porque me sale este mensaje al ejecutar ma funcion:
Se bloquea en la expresion “Rs As Recordset” y aparese un mensaje de error de complilacion “No se ha definido el tipo definido por el usuario”
Hola Lixardo, gracias por tu comentario. Perdona el retraso pero aún no estamos al 100% después del verano.
Ese mensaje de error se produce cuando te falta alguna referencia. De memoria no sé decirte cúal es, pero revisa los destellos de la serie que creo recordar que en algún momento se menciona.
Un saludo