Excel 2016 VBA - 比较2个数据透视表字段以匹配值

Question

嗨请有人帮忙，Excel 2016 VBA数据透视表对象。我很少在Excel VBA中开发。

总体目标：将PivotTable2的单列[P_ID]值列表与PivotTable1进行比较（如果它们存在或不存在），以便对PivotTable1中的这些有效值进行过滤。

我有一些Excel 2016 VBA代码，我从之前的答案改编自不同的互联网来源。

逻辑是：从ComparisonTable数据集（在PowerPivot模型中）从PivotTable2收集数据，字段[P_ID]值列表。生成一个测试行作为函数的输入，以测试PivotTable1中对Mastertable数据集的字段和值的存在，如果为true，则将该行添加为有效（如果不是跳过该行）。最后使用VALID P_ID值过滤PivotTable1。

它一直有效，直到它到达生成错误的bFieldItemExists函数：

运行时错误'1004'无法获取PivotField类的PivotItems属性

有人可以纠正这种不起作用的方式吗？

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Dim MyArray As Variant, _
    ar As Variant, _
    x As String, _
    y As String, _
    str As Variant

MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange

For Each ar In MyArray
    x = "[MasterTable].[P_ID].&[" & ar & "]"

    If ar <> "" And bFieldItemExists(x) = True Then
        If str = "" Then
            str = "[MasterTable].[P_ID].&[" & ar & "]"
        Else
            str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
        End If
    End If
Next ar


Dim str2() As String

    str2 = Split(str, ",")

    Application.EnableEvents = False
    Application.ScreenUpdating = False

        ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


Function bFieldItemExists(strName As String) As Boolean
    Dim strTemp As Variant

    ' This line does not work!?
  strTemp = ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").PivotItems(strName)

If Err = 0 Then bFieldItemExists = True Else bFieldItemExists = False

End Function

Answer 1

由于使用方括号[]而发生1004错误。删除那些。

当您将对象设置为某个对象时，还需要使用关键字Set。例如Set MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.[P_ID").DataRange。

如果您不使用Set，您将收到一个VBA运行时错误对话框，其中显示运行时错误'91'：对象变量或With块变量未设置

我不能保证我的编辑将完全解决您的问题，因为我没有您的数据集并且无法完全测试您的代码。您需要在VBA编辑器中使用调试模式并单步执行代码。为此设置了Set mDataRange = Active...的断点。要设置断点，请转到“调试”菜单并选择“切换断点”子菜单项，也可以按F9设置断点。

现在，当您对Pivot表进行更改时，Worksheet_PivotTableUpdate事件将会触发，代码将在该点执行。

由于断点代码停止执行后，您可以按F8键单步执行代码。如果要继续执行到下一个断点，可以按F5。此外，当您获得VBA错误对话框时，您可以点击Debug，然后使用F8键单步或使用调试窗口查看您的变量和对象包含的内容。我确定在VBA调试中有一些很好的YouTube视频。

单步执行代码时，可以使用“立即”窗口，“监视”窗口和“本地”窗口观察每个变量/对象包含的内容。要打开这些窗口，请转到菜单项View，然后单击每个子菜单项。

以下是在调试之前编辑代码的方法。

Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    'Better practice is to not use the underscore character to
    'continue a Dim declaration line
    Dim mDataRange As Range
    Dim ar As Range
    Dim x As String
    Dim y As String
    Dim str As Variant

    'Use Set to assign the object mDataRange a reference to the the right
    'hand side of the equation.  Remove the square brackets
    'MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
    Set mDataRange = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.P_ID").DataRange

    For Each ar In mDataRange
        'You need to specify what proprerty from ar you
        'want to assign to x.  Assuming the value stored in
        'ar.Value2 is a string, this should work.
        'We use value2 because it is the unformmated value
        'and is slightly quicker to access than the Text or Value
        'properties
        'x = "[MasterTable].[P_ID].&[" & ar & "]"
        x = "MasterTable.P_ID." & ar.Value2

        'Once again specify the Value2 property as containing
        'what value you want to test
        If ar.Value2 <> "" And bFieldItemExists(x) = True Then
            If str = "" Then
                'Remove the square brackets and use the specific property
                'str = "[MasterTable].[P_ID].&[" & ar & "]"
                str = "MasterTable.P_ID." & ar.Value2
            Else
                'Remove the square brackets and use the specific property
                'str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
                str = str & "," & "MasterTable.P_ID." & ar.Value2
            End If
        End If
    Next ar


Dim str2() As String

    str2 = Split(str, ",")

    Application.EnableEvents = False
    Application.ScreenUpdating = False
        'Remove square brackets
        'ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
        ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").VisibleItemsList = Array(str2)

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


Function bFieldItemExists(strName As String) As Boolean

    'Declare a PivotItem to accept the return value
    Dim pvItem As PivotItem
    'Since you want to trap for an error, you'll need to let the VBA runtime know
    'The following code is a pseudo Try/Catch.  This tells the VBA runtime to skip
    'the fact an error occured and continue on to the next statement.
    'Your next statement should deal with the error condition
    On Error Resume Next

    'Use Set whenever assigning an object it's "value" or reference in reality
    Set pvItem = ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").PivotItems(strName)

    'Assuming that an error gets thrown when strName is not found in the pivot
    'Err is the error object.  You should access the property you wish to test
    If Err.Number = 0 Then
        bFieldItemExists = True
    Else
        bFieldItemExists = False
    End If

    'Return to normal error functioning
    On Error GoTo 0
End Function

最后，我意识到其中一些应该在评论部分，但我需要解释太多，以帮助Learner74。但最重要的是，我希望我能帮助他。多年来，我已经从VBA Stack Overflow交易所中使用了很多建议，建议和解释，我只想通过向前付款来偿还。

其他有用的链接：

Chip Pearson是VBA所有东西的网站和人物

Paul Kelly's Excel Macro Mastery是Excel和VBA问题的另一个网站。

Microsoft Excel Object Model有时是有用的，但需要改进。太多的对象缺乏示例，但至少可以指向正确的方向。