使用VBA重复计数创建数据透视表(Creating Pivot Table with Distinc

我想创建使用Excel 2013 VBA与重复计数的值字段数据透视表。

我明白，如果你手动创建数据透视表，你必须检查，以具有价值透视字段重复计数选项“此数据添加到数据模型”复选框，但我不知道如何翻译成VBA这码。

我试图创建与xlCount枢轴表作为valuue透视字段，它工作得很好，但对于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:

我只是记录创建使用该选项透视表“这个数据添加到数据模型”。 创造一个独特的计数字段。 我必须先添加数量，然后将其更改为显着。 我修改了它为您的工作表和数据透视表的名称。 添加的appno测量计数，然后修改以区别。 这里是重复计数部分。

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到该范围，然后再使用的pivotcache的连接。

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

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

文章来源: Creating Pivot Table with Distinct Count using VBA