VBA Расчет разницы между этой неделей/на прошлой неделе и в этом месяце/в прошлом месяце в сводной таблице

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 

End результат выглядит;