Option Explicit
'//By JuanC - Ene. 2009
Sub test()
Dim rng As Range, h As Range, ws As Worksheet
Dim i&, lCount&, sAdd$, sFirst$, sLast$
On Error Resume Next
Set ws = Sheets(1)
If Not ws.FilterMode Then GoTo fin '//No hay filtro aplicado
'//Toma rango del Autofiltro
Set rng = ws.AutoFilter.Range '//Ej: $B$2:$D$13
If Not rng Is Nothing Then
'//Reduce rango del Autofiltro (quita 1er fila)
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1) '//Ej: $B$3:$D$13
'//Reduce nuevamente el rango del Autofiltro
'//(toma sólo la primer columna del rango del Autofiltro)
sAdd = rng.Address
sFirst = Split(sAdd, "$")(1)
sLast = Split(Cells(, rng.SpecialCells(xlCellTypeLastCell).Column).Address, "$")(1)
sAdd = Replace(sAdd, sLast, sFirst) '// $B$3:$D$13 -> $B$3:$B$13
Set rng = Range(sAdd)
'//Verifica si hay datos como resultado del Autofiltro (filas visibles)
Set h = Nothing
Set h = rng.SpecialCells(xlCellTypeVisible)
If h Is Nothing Then GoTo fin
sAdd = h.Address '//Ej: $B$4,$B$7:$B$8,$B$12
'//Cuenta las filas tomando rango por rango (celda individual o
'//celdas contiguas), esto es: $B$4, luego $B$7:$B$8 y por último $B$12
Do
Set h = Range(Split(sAdd, ",")(i))
If h Is Nothing Then Exit Do
i = i + 1
lCount = lCount + h.Rows.Count '//Contador
Set h = Nothing
Loop
End If
fin:
MsgBox lCount
Set rng = Nothing
Set ws = Nothing
Set h = Nothing
End Sub
Saludos desde Baires, JuanC
