Excel 数据透视表向下钻取到单个工作表(帮助我当前的代码)

Question

美好的一天，

我有一个在Excel中带有数据透视表的报表。我的经理要求，当她双击数据透视表时，源数据不是每次都在新工作表上。作为一个 VBA 菜鸟，我设法在网上获得帮助，并且我有以下代码确实有效，但是我需要一些帮助来调整它以获得我想要的结果。请有人帮助我。

当前工作簿代码：

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If CS <> "" Then
With Application
ScreenUpdating = False
Dim NR&
With Sheets("DrillDown")
If WorksheetFunction.CountA(.Rows(1)) = 0 Then
NR = 1
Else
NR = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, 
SearchDirection:=xlPrevious).Row + 2
End If
Range("A1").CurrentRegion.Copy .Cells(NR, 1)
End With
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
Sheets(CS).Select
.ScreenUpdating = True
End With
End If
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target 
As Range, Cancel As Boolean)
If ActiveSheet.Name = "Movement Of Stock" Then
CS = "Movement Of Stock"
ElseIf ActiveSheet.Name = "DrillDown" Then
If Not IsEmpty(Target) Then
If Target.Row > Range("A1").CurrentRegion.Rows.Count + 1 _
Or Target.CurrentRegion.Cells(1, 1).Address = "$A$1" Then
Cancel = True
With Target.CurrentRegion
.Resize(.Rows.Count + 1).EntireRow.Delete
End With
End If
End If
End If
End Sub

当前模块代码：

Public CS$

当前代码工作正常，并将源数据放入"明细"工作表中，然后将我带回数据透视表。当我双击其他地方时，它再次工作，并将该数据放在前一个数据下，并分隔一行。

1(我想要的是，每次双击数据透视表时，首先清除DrillDown工作表中的任何数据，然后添加新数据(换句话说，我不希望每次双击都会堆叠数据(。

2(当前代码还会在双击后将用户返回到数据透视表。我希望用户被带到钻取表。

非常感谢您的帮助！

Answer 1

我相信您只需更改 NewSheet 事件即可满足您的 2 个要求。

我已经评论了这些更改以使这不言自明(？

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If CS <> "" Then
With Application
ScreenUpdating = False
Dim NR&
With Sheets("DrillDown")
'Set this to always start at the top of the page
NR = 1
'..and to clear the Drilldown tab..
.Cells.ClearContents
'instead of this..
'   If WorksheetFunction.CountA(.Rows(1)) = 0 Then
'   NR = 1
'Else
'   NR = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 2
'End If
Range("A1").CurrentRegion.Copy .Cells(NR, 1)
End With
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
'Below is commented out to stop user being returned to Pivot
' Sheets(CS).Select 
.ScreenUpdating = True
End With
End If
End Sub