Excel Pivot Table 深入到单个工作表（使用我当前的代码提供帮助）

debugcn 发表于 Dev

格雷梅林

再会，

我在 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$

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

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

2）当前代码也让用户在双击后返回到数据透视表。我希望用户被带到 DrillDown 表。

非常感谢您的帮助！

CLR

我相信您只需更改 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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。