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$

当前代码可以正常工作，并将源数据放入DrillDown工作表中，然后将我带回到我的数据透视表。当我双击其他位置时，它再次起作用，并将该数据放在前一行的下面。

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

Excel数据透视表深入到单张纸（借助我当前的代码）

1 个答案: