Excel Office 365 VBA -数据透视表-锁定的字段和筛选器列表

wbgh16ku  于 2023-03-09  发布在  其他
关注(0)|答案(1)|浏览(136)

我在网站上找到了我的问题的答案，如何创建一个透视表与VBA，并有可能选择函数"xlDistinctCount" Creating Pivot Table with Distinct Count using VBA通过调整代码，以我的需要。事实上，我用Asger的代码创建三个透视表（与三个不同的数据源）在同一个宏，它的工作非常好，特别是关于函数"xlDistinctCount，但我面临一个问题：
关于三个数据透视表，前两个数据透视表的字段列表和过滤器被锁定，而对于最后创建的数据透视表，我可以访问它们。我通过删除最后两个数据透视表进行了测试，我只保留了第一个数据透视表，结果是我最终可以访问字段列表和过滤器。为什么只有当后面没有其他数据透视表时，我才可以访问数据透视表的字段列表和筛选器？
下面是我的代码：

Sub KPI()

    Application.ScreenUpdating = False
' First Pivot Table
Dim objSheetWithData As Worksheet
Dim objSheetWithPivot As Worksheet
Dim objListObjectWithData As ListObject
Dim objConnection As WorkbookConnection
Dim objPivotCache As PivotCache
Dim objPivotTable As PivotTable
Dim objCubeField As CubeField
Dim objPivotField As PivotField
Set objSheetWithData = ActiveWorkbook.Sheets("LIVRAISON")
Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD SERVICE LEVEL")
If objSheetWithData.ListObjects.Count > 0 Then
    Set objListObjectWithData = objSheetWithData.ListObjects(1)
Else
    Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                SourceType:=xlSrcRange, _
                                Source:=objSheetWithData.Range("LIVRAISON"), _
                                XlListObjectHasHeaders:=xlYes)
End If
For Each objConnection In ActiveWorkbook.Connections
    If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
Next objConnection
Set objConnection = ActiveWorkbook.Connections.Add2( _
                    Name:="My Connection", _
                    Description:="My Connection Description", _
                    ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                    CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                    lCmdtype:=XlCmdType.xlCmdExcel, _
                    CreateModelConnection:=True, _
                    ImportRelationships:=False)
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                    SourceType:=xlExternal, _
                    SourceData:=objConnection)
With objPivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsNone
End With
For Each objPivotTable In objSheetWithPivot.PivotTables
    objPivotTable.TableRange2.Clear
Next objPivotTable
Set objPivotTable = objPivotCache.CreatePivotTable( _
                    TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD LIVRAISON")
With objPivotTable.CubeFields(7)
    .Orientation = xlPageField
    .Caption = "IDH + Designation"
End With
objPivotTable.PageFields(1).Caption = "IDH + Designation"
With objPivotTable.CubeFields(9)
    .Orientation = xlPageField
    .Caption = "Brand"
End With
objPivotTable.PageFields(2).Caption = "Brand"
With objPivotTable.CubeFields(11)
    .Orientation = xlPageField
    .Caption = "Market"
End With
objPivotTable.PageFields(3).Caption = "Market"
With objPivotTable.CubeFields(8)
    .Orientation = xlPageField
    .Caption = "Type of Product"
End With
objPivotTable.PageFields(4).Caption = "Type of Product"
With objPivotTable.CubeFields(10)
    .Orientation = xlPageField
    .Caption = "Business Unit"
End With
objPivotTable.PageFields(5).Caption = "Business Unit"
With objPivotTable.CubeFields(15)
    .Orientation = xlPageField
    .Caption = "100% ?"
End With
objPivotTable.PageFields(6).Caption = "100% ?"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(14), _
                   Function:=xlAverage, _
                   Caption:="Service Rate")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(1).Caption = "Service Level (%)"
objPivotTable.DataFields(1).NumberFormat = "0.00%"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(13), _
                   Function:=xlSum, _
                   Caption:="Quantity delivered")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(2).Caption = "Quantity Delivered (PAL)"
objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(7), _
                   Function:=xlDistinctCount, _
                   Caption:="IDH + Designation")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(3).Caption = "Number of SKUs"
objPivotTable.DataFields(3).NumberFormat = "#,##0"

' Second Pivot Table
Set objSheetWithData = ActiveWorkbook.Sheets("NDR")
Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD RUPTURE RATE")
If objSheetWithData.ListObjects.Count > 0 Then
    Set objListObjectWithData = objSheetWithData.ListObjects(1)
Else
    Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                SourceType:=xlSrcRange, _
                                Source:=objSheetWithData.Range("NDR"), _
                                XlListObjectHasHeaders:=xlYes)
End If
For Each objConnection In ActiveWorkbook.Connections
    If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
Next objConnection
Set objConnection = ActiveWorkbook.Connections.Add2( _
                    Name:="My Connection", _
                    Description:="My Connection Description", _
                    ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                    CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                    lCmdtype:=XlCmdType.xlCmdExcel, _
                    CreateModelConnection:=True, _
                    ImportRelationships:=False)
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                    SourceType:=xlExternal, _
                    SourceData:=objConnection)
With objPivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsNone
End With
For Each objPivotTable In objSheetWithPivot.PivotTables
    objPivotTable.TableRange2.Clear
Next objPivotTable
Set objPivotTable = objPivotCache.CreatePivotTable( _
                    TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD NDR")
With objPivotTable.CubeFields(6)
    .Orientation = xlPageField
    .Caption = "IDH + Designation"
End With
objPivotTable.PageFields(1).Caption = "IDH + Designation"
With objPivotTable.CubeFields(8)
    .Orientation = xlPageField
    .Caption = "Brand"
End With
objPivotTable.PageFields(2).Caption = "Brand"
With objPivotTable.CubeFields(10)
    .Orientation = xlPageField
    .Caption = "Market"
End With
objPivotTable.PageFields(3).Caption = "Market"
With objPivotTable.CubeFields(7)
    .Orientation = xlPageField
    .Caption = "Type of Product"
End With
objPivotTable.PageFields(4).Caption = "Type of Product"
With objPivotTable.CubeFields(9)
    .Orientation = xlPageField
    .Caption = "Business Unit"
End With
objPivotTable.PageFields(5).Caption = "Business Unit"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(5), _
                   Function:=xlSum, _
                   Caption:="CPV (OOS) [EUR]")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(1).Caption = "OOS (EUR)"
objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(4), _
                   Function:=xlSum, _
                   Caption:="(OOS) [CON]")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(2).Caption = "OOS (CON)"
objPivotTable.DataFields(2).NumberFormat = "#,##0"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(6), _
                   Function:=xlDistinctCount, _
                   Caption:="IDH + Designation")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(3).Caption = "Number of SKUs"
objPivotTable.DataFields(3).NumberFormat = "#,##0"

' Third Pivot Table
Set objSheetWithData = ActiveWorkbook.Sheets("PRODUCTION")
Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD VALUE AND VOLUME")
If objSheetWithData.ListObjects.Count > 0 Then
    Set objListObjectWithData = objSheetWithData.ListObjects(1)
Else
    Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                SourceType:=xlSrcRange, _
                                Source:=objSheetWithData.Range("PRODUCTION"), _
                                XlListObjectHasHeaders:=xlYes)
End If
For Each objConnection In ActiveWorkbook.Connections
    If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
Next objConnection
Set objConnection = ActiveWorkbook.Connections.Add2( _
                    Name:="My Connection", _
                    Description:="My Connection Description", _
                    ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                    CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                    lCmdtype:=XlCmdType.xlCmdExcel, _
                    CreateModelConnection:=True, _
                    ImportRelationships:=False)
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                    SourceType:=xlExternal, _
                    SourceData:=objConnection)
With objPivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsNone
End With
For Each objPivotTable In objSheetWithPivot.PivotTables
    objPivotTable.TableRange2.Clear
Next objPivotTable
Set objPivotTable = objPivotCache.CreatePivotTable( _
                    TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD PRODUCTION")
With objPivotTable.CubeFields(9)
    .Orientation = xlPageField
    .Caption = "IDH + Designation"
End With
objPivotTable.PageFields(1).Caption = "IDH + Designation"
With objPivotTable.CubeFields(11)
    .Orientation = xlPageField
    .Caption = "Brand"
End With
objPivotTable.PageFields(2).Caption = "Brand"
With objPivotTable.CubeFields(13)
    .Orientation = xlPageField
    .Caption = "Market"
End With
objPivotTable.PageFields(3).Caption = "Market"
With objPivotTable.CubeFields(10)
    .Orientation = xlPageField
    .Caption = "Type of Product"
End With
objPivotTable.PageFields(4).Caption = "Type of Product"
With objPivotTable.CubeFields(12)
    .Orientation = xlPageField
    .Caption = "Business Unit"
End With
objPivotTable.PageFields(5).Caption = "Business Unit"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(5), _
                   Function:=xlSum, _
                   Caption:="Stock Value")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(1).Caption = "Stock Value (EUR)"
objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(15), _
                   Function:=xlSum, _
                   Caption:="Amount of PAL")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(2).Caption = "Quantity Produced (PAL)"
objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(9), _
                   Function:=xlDistinctCount, _
                   Caption:="IDH + Designation")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(3).Caption = "Number of SKUs"
objPivotTable.DataFields(3).NumberFormat = "#,##0"
Application.ScreenUpdating = True    
End Sub
excel

1条答案

按热度按时间
ecfsfe2w

ecfsfe2w1#

这可能是由于对每个透视表使用相同的连接名称覆盖了连接。可能是更改了：将objConnection = ActiveWorkbook.Connections.Add2（_ Name：=“我的连接”，_设置为“我的连接1”、“我的连接2”、“我的连接3”？（我没有测试这个）。

赞(0）分享  回复(0）举报  2023-03-09
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com