excel 如果CubeField.Orientation = xlPageField,如何设置PivotField.HiddenItemsList属性值

66bbxpm5  于 2023-04-22  发布在  其他
关注(0)|答案(3)|浏览(153)

任务是自动化OLAP透视表数据过滤。在名为sPivotFieldName的透视字段中有一些项目需要排除。下面的代码工作得很好。

With Worksheets(sWorksheetName).PivotTables(sPivotTableName)
    With .CubeFields(sCubeFieldName)
        .Orientation = xlRowField
        .IncludeNewItemsInFilter = True
    End With
    .PivotFields(sPivotFieldName).HiddenItemsList = vSomeItemsToExclude
End With

但是当我试图将多维数据集字段“.Orientation”属性的值更改为xlPageField时,问题出现了。每次都会引发运行时错误1004。下面是一个示例:

With Worksheets(sWorksheetName).PivotTables(sPivotTableName)
    With .CubeFields(sCubeFieldName)
        .Orientation = xlPageField
        .IncludeNewItemsInFilter = True
    End With
    .PivotFields(sPivotFieldName).HiddenItemsList = vSomeItemsToExclude
End With

原因似乎是页面字段中的字段项在被放置在行字段中时是不可见的(例如,可以将其视为行标题)。或者可能还有其他原因。我错过了什么?

rjee0c15

rjee0c151#

这个功能显然不适用于PageFields。在我看来,一个解决方案是使用.VisibleITemsList方法,但要确保它不包括您想要排除的项。
要做到这一点,你需要将所有未过滤的项目转储到一个变量中,循环变量寻找你想要隐藏的术语,如果你找到了,只需将该元素替换为你不想隐藏的其他元素。(这节省了你创建一个没有该项目的新数组)。
棘手的事情是获取所有未过滤项目的列表:如果数据透视表没有应用某种过滤器,.VisibleItemsList就不会给予你。所以我们需要偷偷地复制数据透视表,将感兴趣的PageField设置为RowField,删除所有其他字段,然后用鼠标悬停完整的项目列表,这样我们就知道在删除应该隐藏的项目之后哪些项目应该是可见的。
这里有一个函数,它可以处理过滤,不管你是处理RowField还是PageField,也不管你是想使用.VisibleItemsList还是. HiddenItemsList来设置过滤器
在你的特殊情况下,你会这样称呼它:FilterOLAP SomePivotField,vSomeItemsToExclude,False

Function FilterOLAP(pf As PivotField, vList As Variant, Optional bVisible As Boolean = True)

    Dim vAll        As Variant
    Dim dic          As Object
    Dim sItem       As String
    Dim i           As Long
    Dim wsTemp      As Worksheet
    Dim ptTemp      As PivotTable
    Dim pfTemp      As PivotField
    Dim sPrefix     As String

    Set dic = CreateObject("Scripting.Dictionary")

    With pf
        If .Orientation = xlPageField Then
        pf.CubeField.EnableMultiplePageItems = True

            If Not pf.CubeField.EnableMultiplePageItems Then pf.CubeField.EnableMultiplePageItems = True
        End If

        If bVisible Then
            If .CubeField.IncludeNewItemsInFilter Then .CubeField.IncludeNewItemsInFilter = False
            .VisibleItemsList = vList
        Else

            If .Orientation = xlPageField Then
                ' Can't use pf.HiddenItemsList on PageFields
                ' We'll need to manipulate a copy of the PT to get a complete list of visible fields
                Set wsTemp = ActiveWorkbook.Worksheets.Add
                pf.Parent.TableRange2.Copy wsTemp.Range("A1")
                Set ptTemp = wsTemp.Range("A1").PivotTable

                With ptTemp
                    .ColumnGrand = False
                    .RowGrand = False
                    .ManualUpdate = True
                    For Each pfTemp In .VisibleFields
                        With pfTemp
                            If .Name <> pf.Name And .Name <> "Values" And .CubeField.Orientation <> xlDataField Then .CubeField.Orientation = xlHidden
                        End With
                    Next pfTemp
                    .ManualUpdate = False
                End With
                sPrefix = Left(pf.Name, InStrRev(pf.Name, ".")) & "&["
                Set pfTemp = ptTemp.PivotFields(pf.Name)
                pfTemp.CubeField.Orientation = xlRowField
                pfTemp.ClearAllFilters

                vAll = Application.Transpose(pfTemp.DataRange)
                For i = 1 To UBound(vAll)
                    vAll(i) = sPrefix & vAll(i) & "]"
                    dic.Add vAll(i), i
                Next i

                'Find an item that we know is visible
                For i = 1 To UBound(vList)
                    If Not dic.exists(vList(i)) Then
                        sItem = vList(i)
                        Exit For
                    End If
                Next i

                'Change any items that should be hidden to sItem
                For i = 1 To UBound(vList)
                    If dic.exists(vList(i)) Then
                        vAll(dic.Item(vList(i))) = sItem
                    End If
                Next i

                .VisibleItemsList = vAll

                Application.DisplayAlerts = False
                wsTemp.Delete
                Application.DisplayAlerts = True

            Else
                If Not .CubeField.IncludeNewItemsInFilter Then .CubeField.IncludeNewItemsInFilter = True
                .HiddenItemsList = vList
            End If
        End If

    End With

End Function
unhi4e5o

unhi4e5o2#

有人请,显示我的例子,它是如何工作的((

Dim pt As PivotTable
Dim pf As PivotField

Set pt = ActiveSheet.PivotTables("Сводная таблица2")
Set pf = pt.PivotFields("[груп бай].[Название клиента].[Название клиента]")
wList = "[груп бай].[Название клиента].&[ООО ""Сеть автоматизированных пунктов выдачи""]"
FilterOLAP(pf, wList, FAlse)

在此调试

> If .Name <> pf.Name And .Name <> "Values" And .CubeField.Orientation
> <> xlDataField Then .CubeField.Orientation = xlHidden
yzuktlbb

yzuktlbb3#

我希望我现在给出答案还不算太晚,只是为了子孙后代。
如果您查看任何OLAP数据透视表上的PivotTable.MDX属性,您可以看到Excel实际上在后台使用的MDX查询来填充数据透视表中显示的数据。受此观察的启发,我对自己说:难道不应该更狡猾一点吗?(a)用PivotCache使用的同一个连接字符串创建一个ADODB连接,(b)自己组合一个适当的MDX查询,(c)直接将结果读入VBA中的一个数组,然后我们可以将PivotField.VisibleItemsList属性赋给它?
这种方法的好处包括…

  • 避免了创建和销毁临时数据透视表以获得完整的项目列表的开销和尴尬;
  • 正确处理成员数超过1,048,575的OLAP数据透视表字段--使用临时数据透视表方法将这些数据放在行上会导致错误,因为数据透视表将超过工作表上的最大行数;并且,
  • 使用MDX查询比Excel默认情况下最可能使用的查询更快、更有效。

废话不多说(或者可能需要更多的ADO?呵呵),下面是我想到的VBA子例程。

' Filter a PivotField in an OLAP PivotTable on either Visible or Hidden items.
Public Sub FilterOLAPPivotField(oPF As PivotField, vItems As Variant, _
        Optional ByVal bVisible As Boolean = True)

    Dim dictItems As Object
    Dim i As Long
    Dim sConn As String, sConnItems() As String
    Dim sCatalog As String
    Dim sQuery As String
    Dim oConn As Object
    Dim oRS As Object
    Dim vRecordsetRows As Variant
    Dim dictVisibleItems As Object

'   In case something fails while we still have the ADODB Connection or Recordset 
'   open, this ensures the subroutine will "fail gracefully" and still close them.
'   Feel free to add some more error handling if you like!

    On Error GoTo Fail

'   Turn on "checkbox mode" for selecting more than one filter item, for convenience.

    oPF.CubeField.EnableMultiplePageItems = True

'   If filtering on Visible items: then we just need to set the PivotField's 
'   VisibleItemsList property to the vItems array, and we can skip the rest.

    If bVisible Then
        oPF.VisibleItemsList = vItems
        Exit Sub
    End If

'   All the rest of this subroutine is just for the case where we want our vItems 
'   to be the *Hidden* items, i.e. so everything *but* those items is visible.

'   Read vItems into a Scripting.Dictionary. This is for convenience; we want to use 
'   its Exists method later. We only really care about the Keys; the Item:=True 
'   is just a dummy.

    Set dictItems = CreateObject("Scripting.Dictionary")
    For i = LBound(vItems) To UBound(vItems)
        dictItems.Add Key:=vItems(i), Item:=True
    Next i

'   Get the connection string from the PivotCache of the PivotField's parent PivotTable 
'     (This assumes it is an OLEDB connection.)
'   The connection string is needed to make a separate connection to the server 
'   with ADODB. It also contains the Initial Catalog, which we also need.

    sConn = Replace$(oPF.Parent.PivotCache.Connection, "OLEDB;", vbNullString, Count:=1)
    sConnItems = Split(sConn, ";")
    For i = LBound(sConnItems) To UBound(sConnItems)
        If sConnItems(i) Like "Initial Catalog=*" Then
            sCatalog = "[" & Split(sConnItems(i), "=")(1) & "]"
            Exit For
        End If
    Next i

'   Construct an MDX query to send to the server, which just gets the UNIQUE_NAME of 
'   all the members in the hierarchy we're interested in.

    sQuery = Join$(Array( _
        "WITH MEMBER [Unique Name] AS", _
        oPF.CubeField.Name & ".CURRENTMEMBER.UNIQUE_NAME", _
        "SELECT [Unique Name] ON 0,", _
        oPF.Name, "ON 1 FROM", _
        sCatalog _
    ))

'   Using ADODB, get the result of the query, and dump it into a Variant array.

    Set oConn = CreateObject("ADODB.Connection")
    Set oRS = CreateObject("ADODB.Recordset")
    oConn.Open sConn
    oRS.Open sQuery, oConn
    vRecordsetRows = oRS.GetRows()

'   The Recordset rows are a multidimensional array with 2 columns: column 0 contains 
'   the member captions, and column 1 (which is the one we want) contains the unique names.
'   So we loop through the result, adding any member which was *not* in vItems to 
'   a new Scripting.Dictionary.

    Set dictVisibleItems = CreateObject("Scripting.Dictionary")
    For i = 0 To oRS.RecordCount - 1
        If Not dictItems.Exists(vRecordsetRows(1, i)) Then
            dictVisibleItems.Add Key:=vRecordsetRows(1, i), Item:=True
        End If
    Next i

'   dictVisibleItems.Keys now contains all member which were *not* in vItems. 
'   All that remains is to set the PivotField's VisibleItemsList to this array!

    oPF.VisibleItemsList = dictVisibleItems.Keys

Fail:
'   Last but not least: don't forget to close the ADODB Connection and Recordset.
'   If we got to this point normally, then (despite the 'Fail' label) we just close 
'   them uneventfully and end.

'   If we jumped here because of an error, then we see a MsgBox at this point, but the 
'   subroutine will try to "fail gracefully" and still close the Connection & Recordset.

'   Just in case we somehow ended up down here via an error raised *before* the 
'   Connection or Recordset was ever open, we also have "On Error Resume Next". 
'   Otherwise, the Close method itself might raise an error, sending us back to 'Fail'
'   and trapping the subroutine in an infinite loop!

    If Err Then
        MsgBox "Something went horribly wrong", vbCritical, "Error"
        Err.Clear
    End If

    On Error Resume Next
    oRS.Close
    oConn.Close

End Sub

如果您有兴趣在自己的Workbook中使用它,那么只需将其复制到标准模块中,并使用相关参数调用它。
例如:FilterOLAPPivotField(ActiveCell.PivotField, Items, False)将过滤活动单元格下的PivotField,以便它包含Items数组中的所有项目 * 除外 *。
我在我的机器上测试时观察到一个奇怪的现象:有时,如果我刚打开一个包含我试图操作的PivotField的工作簿,CubeField.EnableMultiplePageItems似乎认为它是只读属性。因为子例程写入此属性,这可能会导致它失败。在UI中单击一次以打开过滤器下拉列表似乎总是使问题消失。不确定这背后的确切原因...也许在我真正与数据透视表交互之前,数据透视缓存没有加载?如果其他人有一些见解,我很有兴趣了解是什么原因导致了这一点。
最后一点补充说明:如果您计划在现有的Excel工作簿上对一堆数据透视域进行一些手动处理,那么您还可以考虑在快速访问工具栏上放置一个按钮,该按钮将活动单元格下的数据透视域上的所有筛选器反转,即包括当前筛选的所有内容并筛选当前包含的所有内容。或者,你可能想有一个带有CommandButton的UserForm,它可以做类似的事情。你可以使用上面的子例程来创建这样一个按钮,通过另一个调用它的子程序,像这样:

' Invert the filters on the OLAP PivotField under the active cell.
Public Sub btnInvertOLAPPivotFieldFilter_Click()
    Dim oPF As PivotField
    Set oPF = ActiveCell.PivotField
    oPF.CubeField.EnableMultiplePageItems = True
    FilterOLAPPivotField oPF, oPF.VisibleItemsList, False
End Sub

相关问题