请教excel中透视表+vba的使用

Sub text()
 ''不用管工作表名称是数字还是数值，用工作表索引号循环即可，我的例子中注释的行可以删掉
  Dim irow, i As Integer
  For i = 1 To WorksheetsCount
    irow = Sheets(i)Range("A1")End(xlDown)Row
    ActiveWorkbookPivotCachesCreate(SourceType:=xlDatabase, SourceData:= _
        Sheets(i)Range("a1:m" & irow), Version:=xlPivotTableVersion15)CreatePivotTable TableDestination:= _
        Sheets(i)Cells(1, 15), TableName:="PivotTable" & i, DefaultVersion:=xlPivotTableVersion15
    ''With Sheets(i)PivotTables("PivotTable" & i)PivotFields("姓名") ''行字段
    ''  Orientation = xlRowField
    ''    Position = 1
    '' End With
    ''Sheets(i)PivotTables("PivotTable" & i)AddDataField Sheets(i)PivotTables("PivotTable" & i _
        )PivotFields("收入"), "求和项:收入", xlSum ''数据区域
    ''With Sheets(i)PivotTables("PivotTable" & i)PivotFields("月份") ''列字段
     ''   Orientation = xlColumnField
     ''  Position = 1
    ''End With
  Next
End Sub

''你的代码中ActiveSheet要改成具体的表名，也就是sheets(i),因为你在循环中，只是选择‘’了sheets(i),而并未激活，所以活动工作表默认还是第一个表，死循环，肯定要出错

程序代码：

Option Explicit
Sub 宏1()
    Dim cnt, arr, i, mon, d_min, d_max
    Set cnt = CreateObject("ScriptingDictionary")
    arr = Range("a1")CurrentRegion
    For i = 2 To UBound(arr)
        If arr(i, 3) < d_min Or IsEmpty(d_min) Then d_min = arr(i, 3)
        If arr(i, 3) > d_max Or IsEmpty(d_max) Then d_max = arr(i, 3)
        mon = Format(arr(i, 3), "yyyy年m月")
        If Not cntExists(mon) Then cntAdd mon, CreateObject("ScriptingDictionary")
        cnt(mon)(arr(i, 2)) = cnt(mon)(arr(i, 2)) + 1
        If arr(i, 4) < 180 Then cnt(mon)("天") = cnt(mon)("天") + 1
    Next i
    ReDim arr(1 To 1000, 1 To 4)
    i = 1
    While d_min < d_max
        mon = Format(d_min, "yyyy年m月")
        arr(i, 1) = mon
        If cntExists(mon) Then
            arr(i, 2) = cnt(mon)Count - 1
            arr(i, 3) = cnt(mon)("天")
            arr(i, 4) = arr(i, 3) / arr(i, 2)
        End If
        If Month(d_min) = 12 Then
            d_min = DateSerial(Year(d_min) + 1, 1, 1)
        Else
            d_min = DateSerial(Year(d_min), Month(d_min) + 1, 1)
        End If
        i = i + 1
    Wend
    i = i - 1
    Range("i2")Resize(i, 4) = arr
    Range("l2")Resize(i, 1)NumberFormatLocal = "000%"
End Sub

测试数据和结果：

---