Excel 正在折叠具有重复发生/名称的数据透视字段

Excel 正在折叠具有重复发生/名称的数据透视字段,excel,vba,Excel,Vba,我有一个数据透视表,我想在其中使用两次数据透视字段(“金额”)。一次作为行,另一次作为值/数据字段。原因是我有给定月份/类别的“总金额”,但我希望能够扩展它以查看单个类别的交易 我的问题是我无法折叠数据透视字段,现在当我展开一个类别时,它会自动展开不是预期反应的事务。我认为这与数据透视字段名称重复出现有关,因为我使用的代码可以折叠其他字段 以下是完整的数据透视表代码和数据透视表示例的屏幕截图 Sub CreatePivotTable() Categories Dim PSheet As W

我有一个数据透视表,我想在其中使用两次
数据透视字段(“金额”)
。一次作为行,另一次作为值/数据字段。原因是我有给定月份/类别的“总金额”,但我希望能够扩展它以查看单个类别的交易

我的问题是我无法折叠数据透视字段,现在当我展开一个类别时,它会自动展开不是预期反应的事务。我认为这与数据透视字段名称重复出现有关,因为我使用的代码可以折叠其他字段

以下是完整的数据透视表代码和数据透视表示例的屏幕截图

Sub CreatePivotTable()

Categories

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

On Error Resume Next
Application.DisplayAlerts = False
'Worksheets("PivotTable").Delete
SheetExists = WorksheetExists("PivotTable")
If Not SheetExists = True Then
    Sheets.Add Before:=PSheet
    PSheet.Name = "PivotTable"
End If
Application.DisplayAlerts = True
Set PSheet = ThisWorkbook.Worksheets("PivotTable")
Set DSheet = ThisWorkbook.Worksheets("Transactions")  '''Source Data Sheet Name'''

LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

PTableExists = ExistPivot("PivotTable")
If PTableExists = True Then
'MsgBox "Deleting PTable!"
 Call DeletePivotTable("PivotTable", "PivotTable")
End If

Set PCache = ThisWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")

Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

'https://docs.microsoft.com/en-us/office/vba/api/excel.pivotfield.orientation
With PSheet.PivotTables("PivotTable").PivotFields("Date")
 .Orientation = xlRowField
 .Position = 1
 .DataRange.Cells(1).Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, False, True)
End With

With PSheet.PivotTables("PivotTable").PivotFields("Categories")
 .Orientation = xlRowField
 .Position = 3
End With

With PSheet.PivotTables("PivotTable").PivotFields("Desc")
 .Orientation = xlRowField
 .Position = 4
End With

With PSheet.PivotTables("PivotTable").PivotFields("Amount")
 .Orientation = xlRowField
 .Function = xlSum
 .Position = 5
End With

With PSheet.PivotTables("PivotTable").PivotFields("Amount")
 .Orientation = xlDataField
 .Function = xlSum
 .Position = 1
End With

PSheet.PivotTables("PivotTable").PivotFields("Date").ShowDetail = False
PSheet.PivotTables("PivotTable").PivotFields("Categories").ShowDetail = False

''''This line doesn't work''''
PSheet.PivotTables("PivotTable").PivotFields("Amount").ShowDetail = False

Worksheets("PivotTable").Activate

End Function
要生成完整的MCVE,这里有一些示例数据,请将其放在名为“Transactions”的工作表中,然后运行上述代码创建数据透视表以进行测试

Date        Desc        Amount   Categories
10/15/2019  CAN TIRE MC     50  Credit Payment
10/25/2019  PC MASTRCRD     50  Credit Payment
下图显示了我展开“信用支付”类别时发生的情况

有人对此有决心吗?我读过使用
DrillTo
和不使用
showdeail
的书,但我根本无法让它工作,但现在我想知道这是否是解决办法,或者我是否可以更具体地处理我要折叠的数据透视字段(以及用于折叠的语句)


行得通,试试他的代码

' doesn't works
PSheet.PivotTables("PivotTable").PivotFields("Desc").PivotItems.ShowDetail = False

'works
PSheet.PivotTables("PivotTable").PivotFields("Desc").ShowDetail = False

' works
Dim pivotItm As PivotItem
 For Each pivotItm In PSheet.PivotTables("PivotTable").PivotFields("Desc").PivotItems
  pivotItm.ShowDetail = False
 Next pivotItm

我可以评论一下类别吗?或者plis append metod的代码。很抱歉,我不明白您的请求Sub中的第一行正在调用Categories Sub。我不知道它的代码。是的,很抱歉设置了类别,但类别已经在我的示例数据中设置。现在您指出了,我必须去掉一些方法调用。它们都可以被注释掉,例如工作表存在或透视表存在。我要到明天才能在电脑前更新帖子,但谢谢你们