vba自动重建数据透视表DataField崩溃

时间:2016-09-14 19:19:13

标签: excel vba excel-vba

我的任务是维护一个包含多个数据透视表的报表,这些数据表汇总了每周更新的数据源表。

数据源有多个列标题会发生变化(例如Oct,Nov,Dec& 9 / 14,9 / 21,9 / 28)。因此,每次刷新数据透视表时,PivotFields都会被丢弃,需要手动重新添加...给我带来巨大的痛苦!无论如何,我一直在尝试自动化这些数据透视表的“重建”。我有代码将添加一个定位的PivotField,但必须输入标题的标题。我正在寻找一种方法将数据源列中的文本传递给更新数据透视的代码。我发布了在输入时有效的版本,以及在我尝试从数据源传递文本时无效的版本。我相信我很接近,但我无法弄清楚为什么这种方法不起作用。任何帮助或想法将不胜感激。

有效的代码:

Sub pivottable1()

   With ActiveSheet.PivotTables("PivotTable4").PivotFields("Sep Actual Hrs thru 9/25")
      .Orientation = xlDataField
      .Position = 2
   End With

End Sub

我尝试从数据源检索标题文本(当前不起作用):

Sub PivotFieldAdd()

Dim pf As PivotField

Worksheets("Actual Data").Select   'name of the data source
'pf = Range("I3").Value

    'With ActiveSheet.PivotTables("PivotTable4").PivotFields("pf")    'this doesn't work either.
    With ActiveSheet.PivotTables("PivotTable4").PivotFields = Range("I3").Value
        .Orientation = xlDataField
        .Position = 2
   End With

End Sub

1 个答案:

答案 0 :(得分:0)

(已解决)目的:在数据源列标题更改时重建数据透视。

Sub WklyPivotFieldAdd()
'Purpose: rebuilds pivot when data source column header changes.
Dim pf1 As String
Dim pf2 As String

Application.ScreenUpdating = False      'Stops screen flicker, increases speed.

pf1 = Worksheets("Actual Data").[I3] 'Location of the data source column header that changes
pf2 = Worksheets("Actual Data").[J3] 'Location of the data source column header that changes

'Sets the PivotField name to the source column name for second column in DataField
   With ActiveSheet.PivotTables("PivotTable4").PivotFields(pf1)
        .Orientation = xlDataField              'Places the new column in the DataField area
        .Position = 2                           'Second column over
   End With

   'Sets the PivotField name to the source column name for Fifth column in DataField
   With ActiveSheet.PivotTables("PivotTable4").PivotFields(pf2)
        .Orientation = xlDataField              'Places the new column in the DataField area
        .Position = 5                           'Fifth column over
   End With
Application.ScreenUpdating = True       'Starts automatic screen updating

End Sub