如何使用多个数据源更新多个数据透视表？

Question

你好美丽的人们！

我正在使用 Excel 2010，并且我正在尝试提出一个方便的宏来更新工作簿中的所有数据透视表。我希望它是通用的，这意味着适用于包含数据透视表的 ANY 工作簿。通过更新，我不仅仅指数据透视表刷新，因为我们报告中的数据正在被重写，并且原始源范围中剩下的所有内容都是标题。这意味着我需要动态地将数据源更改为新范围。

示例： 我有一个仪表板，在摘要表上有 8 个数据透视表。每个 Pivot 表在不同的工作表上都有自己的 DataSource（pivot1 在 Sheet1 上有数据，pivot2 在 Sheet2 上有数据，等等）

我从一个基本宏开始，它更改/更新单个数据透视表的数据源，我在其他宏的各种迭代中使用它——取自here：

ActiveWorkbook.PivotTables(PivotTable1).ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData, _
        Version:=xlPivotTableVersion15)

现在，我的思考过程是这样的： 由于标题是 SourceData 中的内容，我需要找到一种方法来获取该范围并使用通常的方法将其扩展到最后一行 lastRow = Cells(Rows.Count, 1).End(xlUp).Row

我尝试使用 .SourceData 属性来实现这一点，但它似乎没用，因为属性 .SourceData 是 Variant 类型。因此，我在 excel 论坛上进行了一些挖掘，并找到了将其转换为所需类型的代码： Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))

我相信我通过一些字符串修剪正确地实现了这一点以获得所需的参考，但即使它在理论上看起来很棒（至少在我看来）我遇到运行时错误（请参见下文）现在我不知所措。因此，我转向你们，看看你们是否可以分享一些知识或提供建议。

这是我需要帮助的当前代码（带有解释）：

Sub pivot_updator()

Dim lastRow As Long
Dim pt As PivotTable
Dim ws As Worksheet
Dim dataArea As Range
Dim sSheetTrim As String
Dim sRangeTrim As String

For Each ws In ActiveWorkbook.Sheets
    For Each pt In ws.PivotTables
        'evaluate String to get Range after conversion from Variant - recovered from another forum
        Set dataArea = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))

        'some trimming to get desired references for lastRow (sheet in which the SourceData are located) and dataArea (starting cell and last column of SourceData)
        sSheetTrim = Left(pt.SourceData, 6)
        sRangeTrim = Left(dataArea.Address, 8)
        lastRow = Sheets(sSheetTrim).Cells(Rows.Count, 1).End(xlUp).Row

        'gluing the starting cell and lastcolumn (sRangeTrim) together with ending cell in last row (lastrow)
        Set dataArea = Range(sRangeTrim & lastRow)

        'test that I am getting correct Range for the pivot SourceData update
        MsgBox dataArea.Address

        'following gives me the Runtime error -2147024809(80070057)
        pt.ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create _
        (SourceType:=xlDatabase, _
        SourceData:=dataArea, _
        Version:=xlPivotTableVersion12)

        'just to be sure the pivot table refreshes after the SourceData is updated
        pt.RefreshTable
    Next pt
Next ws

MsgBox "Pivot Update Done"
End Sub

运行此 Sub 提示我 运行时错误 -2147024809(80070057)： “数据透视表字段名称无效。要创建数据透视表报表，您必须使用组织为带有标签列的列表的数据，如果要更改数据透视表字段的名称，则必须为该字段键入新名称。 "

它应该做的是循环遍历所有数据透视表并将它们各自的数据源范围扩展到最后一行。

由于这应该是所有时间的通用宏，您应该能够在任何包含数据透视表的工作簿上自己测试它。

我将不胜感激任何建议和建议，也请随意批评我的编码，我对 VBA 还很陌生。感谢您花时间研究我的问题并将您的美丽投入其中。

Answer 1

美丽的人，

幸运的是，在休息并以清醒的头脑回到这个问题之后，我能够确定问题所在。即使动态范围单元格引用设置正确，范围的范围也没有。 dataArea 中没有 Sheet 信息，这就是出现无效数据透视表的运行时错误的原因。这可能是Application.Evaluate 省略了工作表引用的结果。

我必须进一步添加一个代码，该代码将字符串地址修剪为包含数据透视源数据所在的工作表名称。

请看下面的修改代码：

Sub pivot_updator()

Dim lastRow As Long
Dim pt As PivotTable
Dim ws As Worksheet
Dim dataArea As Range
Dim sSheetTrim As String
Dim sRangeTrim As String
Dim SourceDataSheet As String

Application.ScreenUpdating = False
Application.Calculation = xlManual

For Each ws In ActiveWorkbook.Sheets
    For Each pt In ws.PivotTables
        'evaluate String to get Range after conversion from Variant - recovered from another forum
        SourceDataSheet = Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1)
        Set dataArea = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))

        'implemented fix - trim to get desired Sheet name on which pivot source data are located
        sSheetTrim = Split(SourceDataSheet, "!")(0)
        sSheetTrim = Split(SourceDataSheet, "'")(1)
        sSheetTrim = Split(sSheetTrim, "]")(1)

        'some trimming to get desired references for lastRow (sheet in which the SourceData are located) and dataArea (starting cell and last column of SourceData)
        sRangeTrim = Left(dataArea.Address, 8)
        lastRow = Sheets(sSheetTrim).Cells(Rows.Count, 2).End(xlUp).Row

        'gluing the starting cell and lastcolumn (sRangeTrim) together with ending cell in last row (lastrow)
        Set dataArea = Sheets(sSheetTrim).Range(sRangeTrim & lastRow)

        'test that I am getting correct Range for the pivot SourceData update

        'following gives me the Runtime error -2147024809(80070057) // MAYBE the DATA AREA DOES NOT DEFINE SHEET
        pt.ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create _
        (SourceType:=xlDatabase, _
        SourceData:=dataArea, _
        Version:=xlPivotTableVersion12)

        'just to be sure the pivot table refreshes after the SourceData is updated
        pt.RefreshTable
    Next pt
Next ws

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

MsgBox "Pivot Update Done"
End Sub

代码现在工作正常，我会看看是否发生了我没有想到的任何事故并​​可能更新代码。

我要感谢任何对此问题发表评论并提出任何解决方案的人，以及查看并阅读它的任何人。

谢谢。