Creating Pivot Table with Distinct Count using VBA

问题

I am trying to create a pivot table using Excel 2013 VBA with DISTINCT COUNT as a value field.

I understand that if you create the pivot table manually, you have to check the "Add this data to the Data Model" checkbox in order to have the distinct count option for the value pivotfield, but I have no idea how to translate this into VBA code.

I've tried creating the pivot table with xlCount as the valuue pivotfield and it worked fine, but for xlDistinctCount it does not work

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

I expect the pivot table to update with the distinct count once the last line is computed like it does with xlCount but it just doesn't do anything with xlDistinctCount

回答1:

I just recorded creating a pivot table that uses the option "Add this data to the Data Model". And created a Distinct count field. I had to add the count first, then change it to Distinct. I modified it for your worksheet and pivot table names. Add the measure count of appno, then modify to Distinct. Here is the distinct count section.

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

回答2:

To get a PivotField.Function = xlDistinctCount, the PivotTable (read: its PivotCache) has to be OLAP-based. Your general approach, where the PivotCache.SourceData points to a Range, doesn't work in this case.

To get it OLAP-based, you can add a WorkbookConnection to that range first, and then use the connection for the pivotcache.

I hope this general approach explains it:

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

来源：https://stackoverflow.com/questions/57258768/creating-pivot-table-with-distinct-count-using-vba