Question

你好漂亮的人！

我正在使用Excel 2010，并且试图提供一个方便的宏，该宏将更新工作簿中的所有数据透视表。我希望它具有通用性，这意味着它适用于包含数据透视表的 ANY 工作簿。通过更新，我的意思不是仅数据透视表刷新，因为报表中的数据将被重写，而原始来源范围中剩下的全部都是标头。这意味着我需要将数据源动态更改为新范围。

示例：我在“摘要”表上有一个带有8个数据透视表的仪表板。每个数据透视表在不同的工作表上都有自己的数据源（数据透视表1在Sheet1上有数据，数据透视表2在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

美丽的人，

幸运的是，稍事休息之后，头脑清醒地回到了这个问题，我得以确定问题所在。即使动态范围单元格引用设置正确，范围的范围也没有设置。 Sheet中没有dataArea信息，这就是为什么存在无效数据透视表的运行时错误的原因。可能是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

代码现在可以正常工作，我将看看是否有我没有想到的不幸事故，并且可能会更新代码。

我要感谢对这个问题发表评论并提出任何解决方案的任何人，也感谢那些阅读并阅读了该问题的人。

谢谢。

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

1 个答案: