求助大佬，有关日期筛选的vba程序的筛选

lchb000

如附件中所示，下当按下“供暖季”按钮后，从F1单元格开始，自动新建一段区域，区域中包含“2001/1/1至2001/3/15”及“2001/11/15至2001/12/31”对应的日期及日平均温度这两列，区域的标头还是“日期”和“日平均温度”。

lchb000

需要编程的文件就是这个。。

sonia_a

Sub 供暖季()
        Dim arr, brr, i As Integer, j As Integer, k As Integer, sum As Single, sum2 As Single
        arr = Range("A1").CurrentRegion.Value
        For i = 2 To UBound(arr)
                If arr(i, 1) >= #1/1/2001# And arr(i, 1) <= #3/15/2001# Then
                        j = j + 1
                        sum = sum + arr(i, 2)
                End If
                If arr(i, 1) >= #11/15/2001# And arr(i, 1) <= #12/31/2001# Then
                        k = k + 1
                        sum2 = sum2 + arr(i, 2)
                End If
        Next i
        ReDim brr(1 To 3, 1 To 2)
        brr(1, 1) = arr(1, 1): brr(1, 2) = arr(1, 2)
        brr(2, 1) = "2001/1/1至2001/3/15": brr(3, 1) = "2001/11/15至2001/12/31"
        brr(2, 2) = VBA.Round(sum / j, 2): brr(3, 2) = VBA.Round(sum2 / k, 2)
        Range("F1").CurrentRegion.ClearContents
        Range("F1").Resize(3, 2).Value = brr
        Cells.Columns.AutoFit
End Sub