Função SubTotal com Condição VBA

Objetivo: Utilizar a função subtotal com uma condição de igualdade. Exemplo: Quantidade de veículos Gol em um intervalo de dados com filtro, ou a soma dos valores dos veículos GOL filtrados no intervalo.

A função subtotal tem por objetivo trabalhar com várias funções em dados filtrados, mas ás vezes é necessário que estas informações sejam filtradas  mesmo na exibição dos dados, como é o caso da figura acima, aonde estão sendo contados apenas os veículos GOL e somado apenas o valor destes mesmos veículos.

A função VBA abaixo realiza o retorno de um intervalo de dados que atende ao critério de filtro, sendo desta forma utilizado no lugar da seleção dos dados na função SubTotal.

'fSubTotalCondicao
'Esta função traz um range de dados conforme a condição determinada
'lRange = intervalo de busca de dados
'lRngValor = intervalo de valores para funções diferentes de contagem
Function fSubTotalCondicao(ByVal lRange As Range, ByVal vValor As Variant, Optional ByVal lRngValor As Range) As Range

    Application.Volatile

    Dim lRangeSelect    As Range
    Dim lRng            As Range
    Dim lCel            As Range
    Dim lSelect         As Range
    Dim lCol            As Long

    Set lRangeSelect = lRange.SpecialCells(xlCellTypeVisible)

    If lRngValor Is Nothing Then
        For Each lCel In lRangeSelect
            If lCel.Value = vValor Then
                If fSubTotalCondicao Is Nothing Then
                    Set fSubTotalCondicao = Range(CStr(lCel.Address))
                Else
                    Set fSubTotalCondicao = Union(Range(CStr(lCel.Address)), Range(CStr(fSubTotalCondicao.Address)))
                End If
            End If
        Next lCel
    Else
        lCol = lRngValor.Column
        For Each lCel In lRangeSelect
            If lCel.Value = vValor Then
                If fSubTotalCondicao Is Nothing Then
                    Set fSubTotalCondicao = Range(CStr(Cells(lCel.Row, lCol).Address))
                Else
                    Set fSubTotalCondicao = Union(Range(CStr(Cells(lCel.Row, lCol).Address)), Range(CStr(fSubTotalCondicao.Address)))
                End If
            End If
        Next lCel
    End If
End Function

A utilização da função é a seguinte:

fSubTotalCondicao(ByVal lRange As Range, ByVal vValor As Variant, Optional ByVal lRngValor As Range) As Range

• lRange = Intervalo aonde será realizado o filtro
• vValor = Valor que será filtrado
• lRngValor = Intervalo aonde serão aplicadas opções diferentes de contagem, tal como soma por exemplo. Este parâmetro é opcional.

Para implementá-la você deve seguir o artigo: http://guiadoexcel.com.br/criando-funcoes-proprias-globais.

Abaixo o download do exemplo:

Marcos Rieper