Bom dia JJsales
Vou tentar te explicar como faz:
Na tua planilha clique em ALT+F11 para abrir o editor de VBA ---> Menu Inserir ---> Neste modulo em branco vc copia e cole esta código:
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
Clique em ALT+Q para voltar a planilha.
Na célula onde vc quer que apareçam os resultados vc terá que digitar a fórmula da função =(ItensÚnicos($A$1:$E$10))
Esta fórmula é de matriz, portanto, no final da fórmula em vez de teclar ENTER, tecle CTRL+SHIFT+ENTER que as chaves serão inseridas automaticamente no início e no final da fórmula.
Vc tem que adaptar a fórmula para o intervalo da tua planilha.
Como a resposta foi útil, clique na mãozinha que fica na parte superior ao lado da ferramenta citar.
Abraço.
Postado : 18/01/2012 6:26 am