VBA计算本周/上周之间的差异＆amp;这个月/上个月在数据透视表中

Question

我有一个用户表单，用户可以在其中生成每周报告。

现在我需要计算并显示在此报告中（红色突出显示的区域），以及与上周和上个月的差异。

我的代码如下;

If lboCharts.Value = "Ranking Changes in A-Bucket" And cboType.Value = "Regions" Then

   Sheets("Report").Select

   If lblCounter.Caption = "" Then

       deleteReportSheet

        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       "RAW!R1C1:R1048576C20", Version:=xlPivotTableVersion14).CreatePivotTable _
       TableDestination:="Report!R1C1", TableName:="regions_ranking_changes_in_a_bucket", DefaultVersion _
       :=xlPivotTableVersion14

       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Month")
           .Orientation = xlPageField
           .Position = 1
       End With
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Pagetype")
           .Orientation = xlPageField
           .Position = 1
       End With
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Pagetype").ClearAllFilters
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Pagetype").CurrentPage = _
           "Region"
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Bucket")
           .Orientation = xlPageField
           .Position = 1
       End With
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Bucket").ClearAllFilters
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Bucket").CurrentPage = "A"
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Date")
           .Orientation = xlColumnField
           .Position = 1
       End With
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Theme")
           .Orientation = xlRowField
           .Position = 1
       End With
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Keyword")
           .Orientation = xlRowField
           .Position = 2
       End With
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").AddDataField ActiveSheet.PivotTables( _
           "regions_ranking_changes_in_a_bucket").PivotFields("Position"), "Count of Position", xlCount
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Count of Position")
           .Caption = "Average of Position"
           .Function = xlAverage
       End With
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Domain")
           .Orientation = xlPageField
           .Position = 1
       End With
       With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket")
           .ColumnGrand = False
           .RowGrand = False
       End With
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Domain").ClearAllFilters
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Domain").CurrentPage = Trim(cboCountry.Value)
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Date").PivotFilters.Add _
       Type:=xlAfterOrEqualTo, Value1:=Trim(tbDate.Value)


       lblCounter.Caption = "1"
       btnGenerateReport.Caption = "Update Report"

   Else   
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Domain").ClearAllFilters
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Domain").CurrentPage = Trim(cboCountry.Value)
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Date").ClearAllFilters
       ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Date").PivotFilters.Add _
       Type:=xlAfterOrEqualTo, Value1:=Trim(tbDate.Value)

   End If

End If

我的报告应该是这样的;

PS：列顺序不稳定。

感谢您的帮助。

提前谢谢。

Answer 1

我终于找到了如何做到这一点，

我添加了以下代码，用于计算previos周之间的差异。

ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").AddDataField ActiveSheet.PivotTables( _
        "regions_ranking_changes_in_a_bucket").PivotFields("Position"), "Count of Position", xlCount

    With ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotFields("Count of Position")
        .Caption = "Weekly Difference"
        .Function = xlAverage
        .Calculation = xlDifferenceFrom
        .BaseField = "Date"
        .BaseItem = "(previous)"
    End With

此部分适用于数据透视表中的图标

 ActiveSheet.PivotTables("regions_ranking_changes_in_a_bucket").PivotSelect _
                "'Weekly Difference'", xlDataAndLabel, True

    Selection.FormatConditions.AddIconSetCondition
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .ReverseOrder = False
        .ShowIconOnly = False
        .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1)
    End With
    Selection.FormatConditions(1).IconCriteria(1).Icon = xlIconGreenUpArrow
    With Selection.FormatConditions(1).IconCriteria(2)
        .Type = xlConditionValueNumber
        .Value = 0
        .Operator = 7
        .Icon = xlIconYellowCircle
    End With
    With Selection.FormatConditions(1).IconCriteria(3)
        .Type = xlConditionValueNumber
        .Value = 1
        .Operator = 7
        .Icon = xlIconRedDownArrow
    End With

结束结果看起来像;