MIME-Version: 1.0 Content-Location: file:///C:/10761221/Mediana.htm Content-Transfer-Encoding: quoted-printable Content-Type: text/html; charset="us-ascii" Mediana

'**************************************************= *****************************

'* Mediana

'* Calcula y devuelve la MEDIANA de los valores del= campo pasado como parámetro

'* Argumentos: --> nCampo: Nombre del campo del = que se desea calcular la Mediana

'        =       --> nTabla: Nombre de la tabla o consulta donde se encuentra nCam= po

'        =       --> nCondicion: OPCIONAl. Igual que una condición WHERE, p= ero sin usar la palabra WHere

'* uso: Mediana Mediana("Precio", "Productos", "Proveedor =3D 'Faluka SA'")

'* Marciano Almohalla 18/01/2007 22:43

'************************************************************************= *******

 

Function Mediana(nCampo As String, nTabla As String, Optional nCondicion As String) = As Long

    Dim dbs As dao.Databas= e, _

        strSql As String, _

        rst As dao.Recordset, _

        i As Integer, _

        bolEsPar As Boolean, _

        lngCentro As Long, _

        item1, item2

       

    Set dbs =3D Cur= rentDb

   =

    'Construimos la sentencia sql que nos devuelva los registros para los que queremos calcular la Mediana

   = If IsNull(nCondicion) Or nCo= ndicion =3D "" Then

        strSql =3D "SELECT " & nCampo & " FROM " & nTabla = & " ORDER BY " & nCampo

    Else=

        strSql =3D "SELECT " & nCampo & " FROM "= & nTabla & " WHERE " & nCondicion & " ORDER BY &qu= ot; & nCampo

    End If

   

    Set rst =3D dbs.OpenRecordset(strSql) 'Abrimos un recordset usando la sql anterior=

    If rst.EOF =3D False T= hen 'Si devuelve registros

        rst.MoveLast

        rst.MoveFirst

    Else 'si no dev= uelve registros cerramos y salimos de la funcion

        rst.Close<= /p>

        Set dbs =3D Nothing

        Exit Function

    End If

   =

    'Determinamos si el numero de registros devuelto por el recordset es= par o no

   = If rst.RecordCount Mod 2 >= ; 0 Then

        bolEsPar =3D False

    Else=

        bolEsPar =3D True

    End If

       

    lngCentro =3D Int(rst.RecordCount / 2) 'Obtenemos el registro central de la serie

   =

    If rst.RecordCount =3D 1 Then 'Si solo hay un registro en el records= et

        Mediana =3D rst(nCampo)

    Else 'Si hay mas de un registro en el recordset

        If Not bolEsPar Then 'Si el numero de registros es impar cogemos el del centro=

        =     rst.Move lngCentro

        =     Mediana =3D rst(nCampo)

        Else= 'Si es par, hacemos la media de los dos centrales

        =     rst.Move lngCen= tro

        =     item1 =3D rst(nCampo)

        =     rst.MovePrevious

        =     item2 =3D rst(nCampo)

        =     Mediana =3D (item1 + item2) / 2

        End If

    End If

   

    rst.Close

    Set dbs =3D Nothing

End Function