Notifications
Clear all

[RESOLVIDO]Contar Valores Unicos + Subtotal  

  RSS

Fernando Fernandes
(@fernandofernandes)
Illustrious Member
Entrou: 12 anos atrás
Posts: 44273
09/04/2010 6:59 am  

Oi Pessoal,

A função personalizada abaixo retorna valores únicos, porém gostaria de saber como faz para integrar com a função subtotal, pois quando utilizo algum filtro ela continua buscando todo o intervalo e não apenas os filtrados.

O argumento é:

=NumUniqueValues(c5:c6800)

Function NumUniqueValues(Rng As Range) As Long
Dim mycell As Range, UniqueVals As New Collection
Application.Volatile
On Error Resume Next
For Each mycell In Rng
UniqueVals.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0
NumUniqueValues = UniqueVals.Count
End Function

Valeu:)

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel


ResponderCitar (Quote)
Fernando Fernandes
(@fernandofernandes)
Illustrious Member
Entrou: 12 anos atrás
Posts: 44273
18/04/2010 4:48 am  


Nasário... veja se é isso:

Function NumUniqueValues(Rng As Range) As Long
Dim mycell As Range, UniqueVals As New Collection
Application.Volatile
On Error Resume Next
For Each mycell In Rng
If Rows(mycell).EntireRow.Hidden = False Then
UniqueVals.Add mycell.Value, CStr(mycell.Value)
End If

Next mycell
On Error GoTo 0
NumUniqueValues = UniqueVals.Count
End Function

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel


ResponderCitar (Quote)
Fernando Fernandes
(@fernandofernandes)
Illustrious Member
Entrou: 12 anos atrás
Posts: 44273
19/04/2010 7:01 am  

Edson,

Funcionou com a alteração abaixo,

Function NumUniqueValues(Rng As Range) As Long

Dim mycell As Range, UniqueVals As New Collection

Application.Volatile

On Error Resume Next

For Each mycell In Rng

If Not mycell.EntireRow.Hidden Then
UniqueVals.Add mycell.Value, CStr(mycell.Value)

End If

Next mycell

On Error GoTo 0

NumUniqueValues = UniqueVals.Count

End Function

Valeu demais!

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel


ResponderCitar (Quote)
Compartilhar: