Question

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

我了解，如果您手动创建数据透视表，则必须选中“将此数据添加到数据模型”复选框，以使值数据透视表具有不同的计数选项，但是我不知道如何转换转换成VBA代码。

我尝试用xlCount作为值枢轴字段创建数据透视表，并且效果很好，但是对于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一样，计算完最后一行后，数据透视表将使用不同的计数进行更新，但是对于xlDistinctCount却不执行任何操作

Answer 1

我刚刚记录了创建一个数据透视表，该数据透视表使用选项“将此数据添加到数据模型”。并创建了一个非重复计数字段。我必须先添加计数，然后将其更改为Distinct。我为您的工作表和数据透视表名称进行了修改。添加appno的度量值计数，然后修改为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创建具有不同计数的数据透视表

3 个答案: