Determinar os n valores mais freqüentes

Se quisermos determinar o valor mais freqüente de um conjunto de dados no excel, podemos utilizar a função MODO.
No entanto, o excel não tem nenhuma função nativa para calcular os n valores mais freqüentes.
A partir desta necessidade, desenvolvi a função personalizada (UDF) abaixo:


Option Base 1
'Adaptado a partir de exemplo disponível em:
' http://spreadsheetpage.com/index.php/tip/identifying_unique_values_in_an_array_or_range/


Function ItensÚnicos(ConjuntoValores As Range) As Variant
'   Aceita um intervalo como input
  
    Application.Volatile
  
    Dim ValÚnicos()     As Variant ' Matriz que contém os valores únicos
    Dim Elemento        As Variant
    Dim Transf          As Variant
    Dim i               As Integer
    Dim j               As Integer
    Dim Correspondência As Boolean
  
'   Contador para os valores únicos
    NumValÚnicos = 0
'   Loop através da matriz ou intervalo
    For Each Elemento In ConjuntoValores
        Correspondência = False
'       Verificar se o valor já foi inserido
        For i = 1 To NumValÚnicos
            If Elemento = ValÚnicos(2, i) Then
                Correspondência = True
                Exit For '(Saída do Loop)
            End If
        Next i
AddItem:
'       Caso não esteja na lista, o valor é inserido na matriz
        If Not Correspondência And Not IsEmpty(Elemento) Then
            NumValÚnicos = NumValÚnicos + 1
            ReDim Preserve ValÚnicos(2, NumValÚnicos)
            'Inserção do valor
            ValÚnicos(2, NumValÚnicos) = Elemento
            'Inserção da frequência correspondente
            ValÚnicos(1, NumValÚnicos) = Application.WorksheetFunction.CountIf(ConjuntoValores, Elemento)
        End If
    Next Elemento
  
  
'   Ordenar matriz com base nas frequências
    For i = 1 To NumValÚnicos
        For j = i + 1 To NumValÚnicos
        If ValÚnicos(1, i) <= ValÚnicos(1, j) Then
        Transf = ValÚnicos(1, j)
        ValÚnicos(1, j) = ValÚnicos(1, i)
        ValÚnicos(1, i) = Transf
        End If
        Next j
    Next i


'   Reorganizar a matriz
    For i = 1 To NumValÚnicos
        Transf = ValÚnicos(1, i)
        ValÚnicos(1, i) = ValÚnicos(2, i)
        ValÚnicos(2, i) = Transf
    Next i
    
'   Atribuição de valor para a função
    ItensÚnicos = ValÚnicos
End Function

Eis aqui um exemplo de uso: http://www.4shared.com/file/h8WHpoUE/ContagemMltipla.html

[ ]s

0 comentários:

Pesquisar este blog

Carregando...

Arquivo do blog