Question

您好，Excel 2016 VBA数据透视表对象可以帮助您。我很少使用Excel VBA进行开发。

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

我有一些Excel 2016 VBA代码，这些代码已根据来自不同Internet来源的先前答案进行了改编。

逻辑是：从比较表数据集（在PowerPivot模型中）的字段[P_ID]值列表中，从PivotTable2收集数据。生成一条测试行作为函数的输入，以针对Mastertable数据集测试PivotTable1中字段和值的存在，如果为true，则将该行添加为有效（如果不跳过该行）。最后，使用有效的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'：对象变量或未设置块变量 < / p>

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

现在，当您对数据透视表进行更改时，将触发Worksheet_PivotTableUpdate事件，并且该代码将在此时最高执行。

由于断点而导致代码停止执行后，您可以按F8键以单步执行代码。如果要恢复执行到下一个断点，可以按F5。同样，当您看到VBA错误对话框时，可以单击Debug，然后使用F8键单步执行，或使用调试窗口查看变量和对象包含的内容。我确定有一些关于VBA调试的优质youtube视频。

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

这是调试之前需要编辑代码的方式。

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

最后，我意识到其中一些应该在评论部分，但是我需要解释太多以帮助学习者74。但最重要的是，我希望我能帮助他。这些年来，我已经使用了VBA Stack Overflow交流中的许多建议，建议和解释，我只是想通过预先付款来偿还。

其他有用的链接：

Chip Pearson是VBA的一切访问者和站点

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

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

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

1 个答案: