Option
Explicit
Sub
QuickAndDirtyButWithComments()
Dim
rng
As
Excel.Range
Dim
rngAreas
As
Excel.Range
Dim
i
As
Long
With
ActiveSheet
If
.AutoFilterMode
Then
.AutoFilterMode =
False
Set
rng = .Range(
"A1"
, .Cells(.Rows.Count,
"B"
).
End
(xlUp))
End
With
rng.AutoFilter Field:=2, Criteria1:=
"JA"
Set
rngAreas = Application.Intersect(rng, rng.Offset(1), rng.SpecialCells(xlCellTypeVisible))
If
Not
rngAreas
Is
Nothing
Then
For
i = 1
To
rngAreas.Areas.Count
Step
1
ActiveSheet.Range(
"BC"
& i).Value = Application.WorksheetFunction.Average(rngAreas.Areas(i).Cells)
Next
i
End
If
If
ActiveSheet.AutoFilterMode
Then
ActiveSheet.AutoFilterMode =
False
End
Sub