MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Calcular quartil no Access

    Compartilhe

    EuLuis
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 29/09/2014

    Calcular quartil no Access

    Mensagem  EuLuis em Dom 12 Jul 2015, 22:11

    Boa tarde,

    Sou novo no fórum e sempre tive excelentes referências dele por isso estou trazendo o seguinte problema buscando a experiência, conhecimento e porque não dizer, paciência de vocês pois não conheço VBA.

    Preciso realizar o cálculo dos quartis direto no Access. Atualmente vinculo o excel na tabela com os dados no Access e faço os cálculos porém, o volume de dados está aumentando consideravelmente.

    Pesquisando pela internet achei esse código que não é da minha autoria. Andei testando e funciona só que lendo todos os valores da tabela, sendo o resultado o mesmo para todos os colaboradores.

    O que busco: Fazer com que o cálculo dos quartis seja realizado mas, obedecendo aos critérios que colocar numa consulta, por exemplo: só quero os quartis do colaborador X ou outro critério: só quero os quartis do colaborador X no dia ou no mês tal.

    Espero ter conseguido me explicar.

    Segue o código que encontrei e anexo a tabela de exemplo que estou estudando o código:

    O Código:

    Function fnQuartile(tableName As String, fieldName As String, _
                                 Optional QWert As Byte = 2) As Double
       Dim lCount As Long
       Dim P1  As Long
       Dim Q1  As Double
       Dim P2  As Long
       Dim Q2  As Double
       Dim P3  As Long
       Dim Q3  As Double
       Dim Result As Double
     
       With CurrentDb.OpenRecordset("SELECT [" & fieldName & _
                                    "] FROM [" & tableName & _
                                   "] WHERE [" & fieldName & "] IS NOT NULL " & _
                                  "ORDER BY [" & fieldName & "];")
           If Not .EOF Then
               .MoveLast
               lCount = .RecordCount
               .MoveFirst
               P1 = Int((1 / 4 * (lCount - 1)) + 1)
               Q1 = (1 / 4 * (lCount - 1)) - Int(1 / 4 * (lCount - 1))
               P2 = Int((2 / 4 * (lCount - 1)) + 1)
               Q2 = (2 / 4 * (lCount - 1)) - Int(2 / 4 * (lCount - 1))
               P3 = Int((3 / 4 * (lCount - 1)) + 1)
               Q3 = (3 / 4 * (lCount - 1)) - Int(3 / 4 * (lCount - 1))
               Select Case QWert
                 'Minimo
                 Case 0
                 .MoveFirst
                 Result = .Fields(fieldName)
                 'Primeiro Quartil
                 Case 1
                   .Move P1 - 1
                   Result = .Fields(fieldName)
                   If Q1 <> 0 Then
                       .MoveNext
                       Result = Result + (.Fields(fieldName) - Result) * Q1
                   End If
                 'Segundo Quartil
                 Case 2
                   .MoveFirst
                   .Move P2 - 1
                   Result = .Fields(fieldName)
                   If Q2 <> 0 Then
                       .MoveNext
                       Result = Result + (.Fields(fieldName) - Result) * Q2
                   End If
                 'Terceiro Quartil
                 Case 3
                   .MoveFirst
                   .Move P3 - 1
                   Result = .Fields(fieldName)
                   If Q3 <> 0 Then
                       .MoveNext
                       Result = Result + (.Fields(fieldName) - Result) * Q3
                   End If
                 'Maximo
                 Case 4
                 .MoveLast
                 Result = .Fields(fieldName)
               End Select
           End If
       End With
       fnQuartile = Result
       End Function
    Anexos
    Capturar.JPG
    Tabela de exemplo
    Você não tem permissão para fazer download dos arquivos anexados.
    (35 Kb) Baixado 10 vez(es)

      Data/hora atual: Sex 09 Dez 2016, 03:52