使用 VBA 创建具有非重复计数的数据透视表 Table

Question

我正在尝试使用 Excel 2013 VBA 将 DISTINCT COUNT 作为值字段来创建数据透视表 table。

我知道如果您手动创建数据透视表 table，则必须选中 "Add this data to the Data Model" 复选框才能为值数据透视表字段设置不同的计数选项，但我不知道如何操作将其翻译成 VBA 代码。

我已经尝试使用 xlCount 作为值数据透视字段创建数据透视表 table，它工作正常，但对于 xlDistinctCount 它不起作用

Set wb = ActiveWorkbook
Set ws = wb.Sheets.Add(Type:=xlWorksheet, After:=Application.Worksheets(1))
Worksheets(1).Range("A1:I" & i).Copy
Worksheets(2).Range("A1").PasteSpecial xlPasteValues
Worksheets(2).Name = "PivotTable"

'Defining data range for pivottable
lastrow = Worksheets("PivotTable").Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Worksheets("PivotTable").Cells(1, Columns.Count).End(xlToLeft).column
Set pRange = Worksheets("PivotTable").Cells(1, 1).Resize(lastrow, lastCol)


On Error Resume Next
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.create _
(SourceType:=xlDatabase, SourceData:=pRange, Version:=xlPivotTableVersion12). _
CreatePivotTable(TableDestination:=Worksheets("PivotTable").Cells(2, 10), _
TableName:="SalesPivotTable")


Set PTable = PCache.CreatePivotTable _
(TableDestination:=Worksheets("PivotTable").Cells(2, 10), TableName:="SalesPivotTable")

With Worksheets("PivotTable").PivotTables("SalesPivotTable").PivotFields("User")
    .Orientation = xlRowField
    .Position = 1
End With

With Worksheets("PivotTable").PivotTables("SalesPivotTable").PivotFields("BinType")
    .Orientation = xlColumnField
    .Position = 1
End With


'Doesn't work with xlDistinctCount but does with xlCount
With Worksheets("PivotTable").PivotTables("SalesPivotTable")
    .AddDataField Worksheets("PivotTable").PivotTables( _
        "SalesPivotTable").PivotFields("AppNo"), "Distinct Count of AppNo", 
         xlDistinctCount
End With

我希望一旦最后一行像 xlCount 那样被计算出来，主元 table 就会更新为不同的计数，但它对 xlDistinctCount

没有任何作用

Answer 1

我刚刚记录了创建一个使用选项 "Add this data to the Data Model" 的枢轴 table。并创建了一个 Distinct 计数字段。我必须先添加计数，然后将其更改为 Distinct。我为您的工作表和数据透视 table 名称修改了它。添加appno的measure count，然后修改为Distinct。这是非重复计数部分。

With Worksheets("PivotTable").PivotTables("SalesPivotTable").PivotFields( _
    "[Measures].[Count of AppNo]")
    .Caption = "Distinct Count of AppNo"
    .Function = xlDistinctCount
End With

Answer 2

要获得 PivotField.Function = xlDistinctCount，PivotTable（阅读：它的 PivotCache）必须是基于 OLAP 的。 PivotCache.SourceData 指向 Range 的一般方法在这种情况下不起作用。

要使其基于 OLAP，您可以先向该范围添加 WorkbookConnection，然后使用数据透视缓存的连接。

我希望这个通用方法能解释它：

Private Sub GenerateNewOLAPbasedPivotTable()
    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

    ' address worksheets
    Set objSheetWithData = ActiveWorkbook.Sheets(1)
    Set objSheetWithPivot = ActiveWorkbook.Sheets(2)

    ' address (existing) listobject with data
    If objSheetWithData.ListObjects.Count > 0 Then
        Set objListObjectWithData = objSheetWithData.ListObjects(1)
    Else
        Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
            SourceType:=xlSrcRange, _
            Source:=objSheetWithData.Range("A1").CurrentRegion, _
            XlListObjectHasHeaders:=xlYes)
    End If

    ' delete existing internal connections if necessary
    For Each objConnection In ActiveWorkbook.Connections
        If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
    Next objConnection

    ' add new connection to above listobject
    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)

    ' create and configure new pivotcache
    Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
        SourceType:=xlExternal, _
        SourceData:=objConnection)
    With objPivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsNone
    End With

    ' delete existing pivottable if necessary
    For Each objPivotTable In objSheetWithPivot.PivotTables
        objPivotTable.TableRange2.Clear
    Next objPivotTable

    ' create and configure new pivottable
    Set objPivotTable = objPivotCache.CreatePivotTable( _
        TableDestination:=objSheetWithPivot.Range("A1"))
    With objPivotTable
        .ColumnGrand = True
        .HasAutoFormat = True
        ' etc.
    End With

    ' example: reference a cubefield by its name
    ' define a rowfield
    With objPivotTable.CubeFields( _
            "[" & objListObjectWithData.Name & "]." & _
            "[" & objListObjectWithData.ListColumns(1).Name & "]")
        .Orientation = xlRowField
        .Caption = "My CubeField 1"
    End With
    objPivotTable.RowFields(1).Caption = "My RowField 1"

    ' example: reference a cubefield by its index
    ' define a columnfield
    With objPivotTable.CubeFields(2)
        .Orientation = xlColumnField
        .Caption = "My CubeField 2"
    End With
    objPivotTable.ColumnFields(1).Caption = "My ColumnField 1"

    ' define a new measure and use it as datafield
    Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
        AttributeHierarchy:=objPivotTable.CubeFields(1), _
        Function:=xlDistinctCount, _
        Caption:="My Cube Measure 1")
    objPivotTable.AddDataField objCubeField
    objPivotTable.DataFields(1).Caption = "My DataField 1"

End Sub

Answer 3

直接获取不到就用Excel.XlConsolidationFunction 喜欢 Excel.XlConsolidationFunction.xlDistinctCount

使用 VBA 创建具有非重复计数的数据透视表 Table

Creating Pivot Table with Distinct Count using VBA

excel

vba

pivot-table

excel-2013